bond 0.10.1.0 → 0.11.0.0
raw patch · 35 files changed
+2470/−1353 lines, 35 filesdep +megaparsecdep +unordered-containersdep −parsecdep ~base
Dependencies added: megaparsec, unordered-containers
Dependencies removed: parsec
Dependency ranges changed: base
Files
- IO.hs +39/−27
- Main.hs +74/−19
- Options.hs +44/−7
- bond.cabal +30/−16
- src/Language/Bond/Codegen/Cpp/Apply_h.hs +1/−1
- src/Language/Bond/Codegen/Cpp/Comm_cpp.hs +0/−33
- src/Language/Bond/Codegen/Cpp/Comm_h.hs +0/−333
- src/Language/Bond/Codegen/Cpp/Grpc_h.hs +88/−215
- src/Language/Bond/Codegen/Cpp/Reflection_h.hs +3/−2
- src/Language/Bond/Codegen/Cpp/Types_cpp.hs +68/−15
- src/Language/Bond/Codegen/Cpp/Types_h.hs +110/−82
- src/Language/Bond/Codegen/Cpp/Util.hs +31/−17
- src/Language/Bond/Codegen/Cs/Comm_cs.hs +0/−209
- src/Language/Bond/Codegen/Cs/Grpc_cs.hs +129/−40
- src/Language/Bond/Codegen/Cs/Types_cs.hs +78/−15
- src/Language/Bond/Codegen/Cs/Util.hs +2/−2
- src/Language/Bond/Codegen/CustomMapping.hs +40/−19
- src/Language/Bond/Codegen/Java/Class_java.hs +638/−0
- src/Language/Bond/Codegen/Java/Enum_java.hs +143/−0
- src/Language/Bond/Codegen/Java/Util.hs +73/−0
- src/Language/Bond/Codegen/Templates.hs +7/−9
- src/Language/Bond/Codegen/TypeMapping.hs +157/−26
- src/Language/Bond/Codegen/Util.hs +30/−4
- src/Language/Bond/Lexer.hs +153/−94
- src/Language/Bond/Parser.hs +107/−94
- src/Language/Bond/Syntax/Internal.hs +5/−0
- src/Language/Bond/Syntax/JSON.hs +104/−7
- src/Language/Bond/Syntax/SchemaDef.hs +1/−6
- src/Language/Bond/Syntax/Types.hs +23/−4
- src/Language/Bond/Syntax/Util.hs +10/−0
- src/Language/Bond/Util.hs +6/−0
- tests/TestMain.hs +71/−16
- tests/Tests/Codegen.hs +75/−38
- tests/Tests/Syntax.hs +12/−3
- tests/Tests/Syntax/JSON.hs +118/−0
IO.hs view
@@ -7,26 +7,28 @@ , parseASTFile , parseNamespaceMappings , parseAliasMappings + , slashNormalize ) where -import System.Exit -import System.FilePath -import System.Directory -import System.IO import Control.Applicative -import Prelude -import Data.Aeson (eitherDecode) -import Data.Text import Control.Monad.Loops (firstM) +import Data.Aeson (eitherDecode) +import Data.Void (Void) import qualified Data.ByteString.Lazy as BL -import Text.Parsec -import Text.ParserCombinators.Parsec.Error -import Text.Printf -import Language.Bond.Syntax.Types (Bond(..)) -import Language.Bond.Syntax.JSON() -import Language.Bond.Parser +import qualified Data.List.NonEmpty as NE +import qualified Data.Text as T import Language.Bond.Codegen.TypeMapping +import Language.Bond.Parser +import Language.Bond.Syntax.JSON() +import Language.Bond.Syntax.Types (Bond(..)) +import Prelude +import System.Directory +import System.Exit +import System.FilePath +import System.IO +import Text.Megaparsec +import Text.Printf parseFile :: [FilePath] -> FilePath -> IO(Bond) @@ -53,9 +55,10 @@ Just path' -> do content <- readFileUtf8 path' return (path', content) - Nothing -> fail $ "Can't find import file " ++ importFile + Nothing -> fail $ "Can't find import file " ++ importFile' where - findFilePath dirs = fmap (</> importFile) <$> firstM (doesFileExist . (</> importFile)) dirs + importFile' = slashNormalize importFile + findFilePath dirs = fmap (</> importFile') <$> firstM (doesFileExist . (</> importFile')) dirs readFileUtf8 name = do h <- openFile name ReadMode @@ -86,21 +89,30 @@ Left err -> fail $ show err Right m -> return m -msbuildErrorMessage :: ParseError -> String +msbuildErrorMessage :: (ParseError Char Void) -> String msbuildErrorMessage err = printf "%s(%d,%d) : error B0000: %s" name line col message where message = combinedMessage err pos = errorPos err - name = sourceName pos - line = sourceLine pos - col = sourceColumn pos + name = sourceName (NE.head pos) + line = unPos $ sourceLine (NE.head pos) + col = unPos $ sourceColumn (NE.head pos) -combinedMessage :: ParseError -> String -combinedMessage err = id $ unpack $ intercalate (pack ", ") messages +combinedMessage :: (ParseError Char Void) -> String +combinedMessage err = id $ T.unpack $ T.intercalate (T.pack ", ") messages where - -- showErrorMessages returns a multi-line String starting with a blank - -- line. We need to break it up to make a useful one-line message. - messages = splitOn (pack "\n") $ strip $ pack $ - showErrorMessages "or" "unknown parse error" - "expecting" "unexpected" "end of input" - (errorMessages err) + -- parseErrorPretty returns a multi-line String. + -- We need to break it up to make a useful one-line message. + messages = T.splitOn (T.pack "\n") $ T.strip $ T.pack $ parseErrorTextPretty err + +-- | Normalizes a file path to only use the current platform's preferred +-- directory separator. +-- +-- Bond doesn't support files or directories with backslashes in their +-- names, so backslashes are always converted to the platform's preferred +-- separator. +slashNormalize :: FilePath -> FilePath +slashNormalize path = map replace path + where replace '/' = pathSeparator + replace '\\' = pathSeparator + replace c = c
Main.hs view
@@ -14,7 +14,8 @@ import Control.Concurrent.Async import GHC.Conc (getNumProcessors, setNumCapabilities) import Data.Text.Lazy (Text) -import qualified Data.Text.Lazy.IO as L +import qualified Data.Text.Lazy as LT +import qualified Data.Text.Lazy.IO as LTIO import Data.Aeson (encode) import qualified Data.ByteString.Lazy as BL import Language.Bond.Syntax.Types (Bond(..), Declaration(..), Import, Type(..)) @@ -36,6 +37,7 @@ case options of Cpp {..} -> cppCodegen options Cs {..} -> csCodegen options + Java {..} -> javaCodegen options Schema {..} -> writeSchema options _ -> print options @@ -52,6 +54,12 @@ concurrentlyFor_ = (void .) . flip mapConcurrently +createDir :: FilePath -> IO () +createDir path = do + -- recursive = True + createDirectoryIfMissing True path + + writeSchema :: Options -> IO() writeSchema Schema {..} = concurrentlyFor_ files $ \file -> do @@ -70,28 +78,28 @@ cppCodegen :: Options -> IO() cppCodegen options@Cpp {..} = do - let typeMapping = maybe cppTypeMapping cppCustomAllocTypeMapping allocator + let typeMappingAliases = maybe cppTypeMapping (cppCustomAllocTypeMapping scoped_alloc_enabled) allocator + let typeMapping = if type_aliases_enabled then typeMappingAliases else cppExpandAliasesTypeMapping typeMappingAliases concurrentlyFor_ files $ codeGen options typeMapping templates where applyProto = map snd $ filter (enabled apply) protocols enabled a p = null a || fst p `elem` a protocols = - [ (Compact, ProtocolReader " ::bond::CompactBinaryReader< ::bond::InputBuffer>") - , (Compact, ProtocolWriter " ::bond::CompactBinaryWriter< ::bond::OutputBuffer>") - , (Compact, ProtocolWriter " ::bond::CompactBinaryWriter< ::bond::CompactBinaryCounter::type>") - , (Fast, ProtocolReader " ::bond::FastBinaryReader< ::bond::InputBuffer>") - , (Fast, ProtocolWriter " ::bond::FastBinaryWriter< ::bond::OutputBuffer>") - , (Simple, ProtocolReader " ::bond::SimpleBinaryReader< ::bond::InputBuffer>") - , (Simple, ProtocolWriter " ::bond::SimpleBinaryWriter< ::bond::OutputBuffer>") + [ (Compact, ProtocolReader " ::bond::CompactBinaryReader<::bond::InputBuffer>") + , (Compact, ProtocolWriter " ::bond::CompactBinaryWriter<::bond::OutputBuffer>") + , (Compact, ProtocolWriter " ::bond::CompactBinaryWriter<::bond::OutputBuffer>::Pass0") + , (Fast, ProtocolReader " ::bond::FastBinaryReader<::bond::InputBuffer>") + , (Fast, ProtocolWriter " ::bond::FastBinaryWriter<::bond::OutputBuffer>") + , (Simple, ProtocolReader " ::bond::SimpleBinaryReader<::bond::InputBuffer>") + , (Simple, ProtocolWriter " ::bond::SimpleBinaryWriter<::bond::OutputBuffer>") ] templates = concat $ map snd $ filter fst codegen_templates codegen_templates = [ (core_enabled, core_files) - , (comm_enabled, [comm_h export_attribute, comm_cpp]) , (grpc_enabled, [grpc_h export_attribute, grpc_cpp]) ] core_files = [ reflection_h export_attribute - , types_h header enum_header allocator + , types_h export_attribute header enum_header allocator alloc_ctors_enabled type_aliases_enabled scoped_alloc_enabled , types_cpp , apply_h applyProto export_attribute , apply_cpp applyProto @@ -111,9 +119,11 @@ else if fields then PublicFields else Properties + constructorOptions = if constructor_parameters + then ConstructorParameters + else DefaultWithProtectedBase templates = concat $ map snd $ filter fst codegen_templates - codegen_templates = [ (structs_enabled, [types_cs Class fieldMapping]) - , (comm_enabled, [comm_interface_cs, comm_proxy_cs, comm_service_cs]) + codegen_templates = [ (structs_enabled, [types_cs Class fieldMapping constructorOptions]) , (grpc_enabled, [grpc_cs]) ] csCodegen _ = error "csCodegen: impossible happened." @@ -132,13 +142,58 @@ namespaceMapping <- parseNamespaceMappings $ namespace options (Bond imports namespaces declarations) <- parseFile (import_dir options) file let mappingContext = MappingContext typeMapping aliasMapping namespaceMapping namespaces - case (anyServiceInheritance declarations, service_inheritance_enabled options, grpc_enabled options, comm_enabled options) of - (True, False, _, _) -> fail "Use --enable-service-inheritance to enable service inheritance syntax." - (True, True, True, _) -> fail "Service inheritance is not supported in gRPC codegen." - (True, True, _, True) -> fail "Service inheritance is not supported in Comm codegen." + case (anyServiceInheritance declarations, service_inheritance_enabled options, grpc_enabled options) of + (True, False, _) -> fail "Use --enable-service-inheritance to enable service inheritance syntax." + (True, True, True) -> fail "Service inheritance is not supported in gRPC codegen." _ -> forM_ templates $ \template -> do let (suffix, code) = template mappingContext baseName imports declarations let fileName = baseName ++ suffix createDirectoryIfMissing True outputDir - let content = if (no_banner options) then code else (commonHeader "//" fileName <> code) - L.writeFile (outputDir </> fileName) content + let content = if (no_banner options) then code else (commonHeader "//" file fileName <> code) + LTIO.writeFile (outputDir </> fileName) content + +-- Java's class-per-file and package-as-path requirements make it difficult to +-- share code with languages where there is a known set of generated files for +-- each bondfile. +javaCodegen :: Options -> IO () +javaCodegen Java {..} = do + namespaceMapping <- parseNamespaceMappings namespace + + concurrentlyFor_ files $ \bondFile -> do + (Bond imports namespaces declarations) <- parseFile import_dir bondFile + -- AliasMappings not implemented. + let mappingContext = MappingContext javaTypeMapping [] namespaceMapping namespaces + + forM_ declarations $ \declaration -> do + let javaNamespace = getDeclNamespace mappingContext declaration + let packageDir = + output_dir </> case javaNamespace of + x:xs -> foldl (</>) x xs + [] -> error "declaration " ++ declName declaration ++ " has no namespace" + let javaFile = declName declaration ++ ".java" + + let code = case declaration of + Struct {} -> class_java mappingContext imports declaration + Enum {} -> enum_java mappingContext declaration + _ -> mempty + + if LT.null code + then return () + else do + let content = + if no_banner + then code + else (commonHeader "//" safeBondFile safeJavaFile <> code) + where + -- javac will always treat "\u" as the start + -- of a unicode escape sequence, and will + -- error out if it isn't followed by a valid + -- code. This breaks compilation of generated + -- code if either path has components that + -- start with u. + safeBondFile = slashForward bondFile + safeJavaFile = slashForward javaFile + + createDir packageDir + LTIO.writeFile (packageDir </> javaFile) content +javaCodegen _ = error "javaCodegen: impossible happened."
Options.hs view
@@ -1,7 +1,7 @@ -- Copyright (c) Microsoft. All rights reserved. -- Licensed under the MIT license. See LICENSE file in the project root for full license information. -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-missing-fields #-} {-# OPTIONS_GHC -fno-cse #-} @@ -16,6 +16,7 @@ import Data.Version (showVersion) import System.Console.CmdArgs import System.Console.CmdArgs.Explicit (processValue) +import IO (slashNormalize) data ApplyOptions = Compact | @@ -39,8 +40,10 @@ , jobs :: Maybe Int , no_banner :: Bool , core_enabled :: Bool - , comm_enabled :: Bool , grpc_enabled :: Bool + , alloc_ctors_enabled :: Bool + , type_aliases_enabled :: Bool + , scoped_alloc_enabled :: Bool , service_inheritance_enabled :: Bool } | Cs @@ -55,10 +58,19 @@ , jobs :: Maybe Int , no_banner :: Bool , structs_enabled :: Bool - , comm_enabled :: Bool , grpc_enabled :: Bool , service_inheritance_enabled :: Bool + , constructor_parameters :: Bool } + | Java + { files :: [FilePath] + , import_dir :: [FilePath] + , output_dir :: FilePath + , using :: [String] + , namespace :: [String] + , jobs :: Maybe Int + , no_banner :: Bool + } | Schema { files :: [FilePath] , import_dir :: [FilePath] @@ -84,8 +96,10 @@ , jobs = def &= opt "0" &= typ "NUM" &= name "j" &= help "Run NUM jobs simultaneously (or '$ncpus' if no NUM is not given)" , no_banner = def &= help "Omit the banner at the top of generated files" , core_enabled = True &= explicit &= name "core" &= help "Generate core serialization definitions (true by default, --core=false to disable)" - , comm_enabled = False &= explicit &= name "comm" &= help "Generate comm definitions" , grpc_enabled = False &= explicit &= name "grpc" &= help "Generate gRPC definitions" + , alloc_ctors_enabled = False &= explicit &= name "alloc-ctors" &= help "Generate constructors with allocator argument" + , type_aliases_enabled = False &= explicit &= name "type-aliases" &= help "Generate type aliases" + , scoped_alloc_enabled = False &= explicit &= name "scoped-alloc" &= help "Use std::scoped_allocator_adaptor for strings and containers" , service_inheritance_enabled = False &= explicit &= name "enable-service-inheritance" &= help "Enable service inheritance syntax in IDL" } &= name "c++" &= @@ -97,12 +111,19 @@ , readonly_properties = def &= name "r" &= help "Generate private property setters" , fields = def &= name "f" &= help "Generate public fields rather than properties" , structs_enabled = True &= explicit &= name "structs" &= help "Generate C# types for Bond structs and enums (true by default, use \"--structs=false\" to disable)" - , comm_enabled = False &= explicit &= name "comm" &= help "Generate C# services and proxies for Bond Comm" , grpc_enabled = False &= explicit &= name "grpc" &= help "Generate C# services and proxies for gRPC" + , constructor_parameters = def &= explicit &= name "preview-constructor-parameters" &= help "PREVIEW FEATURE: Generate a constructor that takes all the fields as parameters. Typically used with readonly-properties." } &= name "c#" &= help "Generate C# code" +java :: Options +java = Java + { using = def &= typ "MAPPING" &= name "u" &= help "Currently unimplemented and ignored for Java" + } &= + name "java" &= + help "Generate Java code" + schema :: Options schema = Schema { runtime_schema = def &= help "Generate Simple JSON representation of runtime schema, aka SchemaDef" @@ -110,14 +131,30 @@ name "schema" &= help "Output the JSON representation of the schema" +slashNormalizeOption :: Options -> Options +slashNormalizeOption Options = Options +slashNormalizeOption o@Cpp{..} = o { files = map slashNormalize files, + import_dir = map slashNormalize import_dir, + output_dir = slashNormalize output_dir } +slashNormalizeOption o@Cs{..} = o { files = map slashNormalize files, + import_dir = map slashNormalize import_dir, + output_dir = slashNormalize output_dir } +slashNormalizeOption o@Java{..} = o { files = map slashNormalize files, + import_dir = map slashNormalize import_dir, + output_dir = slashNormalize output_dir } +slashNormalizeOption o@Schema{..} = o { files = map slashNormalize files, + import_dir = map slashNormalize import_dir, + output_dir = slashNormalize output_dir } + + mode :: Mode (CmdArgs Options) -mode = cmdArgsMode $ modes [cpp, cs, schema] &= +mode = cmdArgsMode $ modes [cpp, cs, java, schema] &= program "gbc" &= help "Compile Bond schema file(s) and generate specified output. The schema file(s) can be in one of two formats: Bond IDL or JSON representation of the schema abstract syntax tree as produced by `gbc schema`. Multiple schema files can be specified either directly on the command line or by listing them in a text file passed to gbc via @listfile syntax." &= summary ("Bond Compiler " ++ showVersion version ++ ", (C) Microsoft") getOptions :: IO Options -getOptions = cmdArgsRun mode +getOptions = slashNormalizeOption <$> cmdArgsRun mode processOptions :: [String] -> Options processOptions = cmdArgsValue . processValue mode
bond.cabal view
@@ -2,9 +2,9 @@ -- Licensed under the MIT license. See LICENSE file in the project root for full license information. name: bond -version: 0.10.1.0 +version: 0.11.0.0 cabal-version: >= 1.8 -tested-with: GHC>=7.4.1 +tested-with: GHC>=8.0.1 synopsis: Bond schema compiler and code generator description: Bond is a cross-platform framework for handling schematized data. It supports cross-language de/serialization and @@ -25,12 +25,16 @@ license: MIT license-file: LICENSE author: Adam Sapek <adamsap@microsoft.com> -maintainer: Adam Sapek <adamsap@microsoft.com> +maintainer: Bond Development Team <bond-dev@microsoft.com> bug-reports: https://github.com/Microsoft/bond/issues copyright: Copyright (c) Microsoft. All rights reserved. category: Language, Compiler, Code Generation build-type: Simple +flag warningsAsErrors + default: False + manual: True + source-repository head type: git location: git@github.com:Microsoft/bond.git @@ -38,15 +42,17 @@ library hs-source-dirs: src build-depends: aeson >= 0.7.0.6 && < 0.12.0.0, - base >= 4.5 && < 5, + base >= 4.9 && < 5, bytestring >= 0.10, filepath >= 1.0, mtl >= 2.1, - parsec >= 3.1, + megaparsec >= 6.2, scientific >= 0.3.4.6, shakespeare >= 2.0, - text >= 0.11 - ghc-options: -Wall + text >= 0.11, + unordered-containers >= 0.2.3.0 + if flag(warningsAsErrors) + ghc-options: -Wall -Werror exposed-modules: Language.Bond.Parser Language.Bond.Util Language.Bond.Syntax.Types @@ -63,16 +69,16 @@ Language.Bond.Codegen.Cpp.Reflection_h Language.Bond.Codegen.Cpp.Types_cpp Language.Bond.Codegen.Cpp.Types_h - Language.Bond.Codegen.Cpp.Comm_cpp - Language.Bond.Codegen.Cpp.Comm_h Language.Bond.Codegen.Cpp.Grpc_cpp Language.Bond.Codegen.Cpp.Grpc_h Language.Bond.Codegen.Cs.Types_cs - Language.Bond.Codegen.Cs.Comm_cs Language.Bond.Codegen.Cs.Grpc_cs Language.Bond.Codegen.Cpp.ApplyOverloads Language.Bond.Codegen.Cpp.Util Language.Bond.Codegen.Cs.Util + Language.Bond.Codegen.Java.Class_java + Language.Bond.Codegen.Java.Enum_java + Language.Bond.Codegen.Java.Util Language.Bond.Lexer Language.Bond.Syntax.Internal Paths_bond @@ -86,8 +92,12 @@ Tests.Codegen Tests.Codegen.Util Tests.Syntax - ghc-options: -threaded -Wall + Tests.Syntax.JSON + ghc-options: -threaded + if flag(warningsAsErrors) + ghc-options: -threaded -Wall -Werror + if os(windows) && arch(i386) ld-options: -Wl,--dynamicbase -Wl,--nxcompat -Wl,--large-address-aware if os(windows) && arch(x86_64) @@ -96,7 +106,7 @@ build-depends: bond, aeson >= 0.7.0.6 && < 0.12.0.0, aeson-pretty == 0.7.2, - base >= 4.5 && < 5, + base >= 4.9 && < 5, bytestring >= 0.10, cmdargs >= 0.10.10, directory >= 1.1, @@ -112,14 +122,18 @@ tasty-golden, tasty-hunit, tasty-quickcheck, - parsec >= 3.1 + shakespeare >= 2.0, + megaparsec >= 6.2 executable gbc main-is: Main.hs other-modules: IO Options - ghc-options: -threaded -Wall + ghc-options: -threaded + if flag(warningsAsErrors) + ghc-options: -threaded -Wall -Werror + if os(windows) && arch(i386) ld-options: -Wl,--dynamicbase -Wl,--nxcompat -Wl,--large-address-aware if os(windows) && arch(x86_64) @@ -128,7 +142,7 @@ build-depends: bond, aeson >= 0.7.0.6 && < 0.12.0.0, async >= 2.0.1.0, - base >= 4.5 && < 5, + base >= 4.9 && < 5, bytestring >= 0.10, cmdargs >= 0.10.10, process < 1.5, @@ -136,4 +150,4 @@ filepath >= 1.0, monad-loops >= 0.4, text >= 0.11, - parsec >= 3.1 + megaparsec >= 6.2
src/Language/Bond/Codegen/Cpp/Apply_h.hs view
@@ -35,7 +35,7 @@ } // namespace bond |]) where - includeImport (Import path) = [lt|#include "#{dropExtension path}_apply.h"|] + includeImport (Import path) = [lt|#include "#{dropExtension (slashForward path)}_apply.h"|] export_attr = optional (\a -> [lt|#{a}|]) export_attribute
− src/Language/Bond/Codegen/Cpp/Comm_cpp.hs
@@ -1,33 +0,0 @@--- Copyright (c) Microsoft. All rights reserved. --- Licensed under the MIT license. See LICENSE file in the project root for full license information. - -{-# LANGUAGE QuasiQuotes, OverloadedStrings, RecordWildCards #-} - -module Language.Bond.Codegen.Cpp.Comm_cpp (comm_cpp) where - -import Data.Monoid -import Prelude -import Data.Text.Lazy (Text) -import Text.Shakespeare.Text -import Language.Bond.Syntax.Types -import Language.Bond.Codegen.TypeMapping -import Language.Bond.Codegen.Util -import qualified Language.Bond.Codegen.Cpp.Util as CPP - --- | Codegen template for generating /base_name/_comm.cpp containing --- definitions of helper functions and schema metadata static variables. -comm_cpp :: MappingContext -> String -> [Import] -> [Declaration] -> (String, Text) -comm_cpp cpp file _imports declarations = ("_comm.cpp", [lt| -#include "#{file}_reflection.h" -#include "#{file}_comm.h" - -#{CPP.openNamespace cpp} - #{doubleLineSepEnd 1 statics declarations} -#{CPP.closeNamespace cpp} -|]) - where - -- definitions of Schema statics for non-generic services - statics s@Service {..} = - if null declParams then CPP.schemaMetadata cpp s else mempty - - statics _ = mempty
− src/Language/Bond/Codegen/Cpp/Comm_h.hs
@@ -1,333 +0,0 @@--- Copyright (c) Microsoft. All rights reserved. --- Licensed under the MIT license. See LICENSE file in the project root for full license information. - -{-# LANGUAGE QuasiQuotes, OverloadedStrings, RecordWildCards #-} - -module Language.Bond.Codegen.Cpp.Comm_h (comm_h) where - -import System.FilePath -import Data.Monoid -import Prelude -import qualified Data.Text.Lazy as L -import Data.Text.Lazy.Builder -import Text.Shakespeare.Text -import Language.Bond.Util -import Language.Bond.Syntax.Types -import Language.Bond.Syntax.Util -import Language.Bond.Codegen.Util -import Language.Bond.Codegen.TypeMapping -import qualified Language.Bond.Codegen.Cpp.Util as CPP - - --- | Codegen template for generating /base_name/_comm.h containing declarations of --- of service interface and proxy. -comm_h :: Maybe String -> MappingContext -> String -> [Import] -> [Declaration] -> (String, L.Text) -comm_h export_attribute cpp file imports declarations = ("_comm.h", [lt| -#pragma once - -#include <bond/comm/services.h> -#include "#{file}_types.h" -#{newlineSep 0 includeImport imports} - -#{CPP.openNamespace cpp} - #{doubleLineSep 1 comm declarations} - -#{CPP.closeNamespace cpp} -|]) - where - includeImport (Import path) = [lt|#include "#{dropExtension path}_comm.h"|] - - cppType = getTypeName cpp - - request mt = request' (payload mt) - where - payload = maybe "void" cppType - request' params = [lt|::bond::comm::payload<#{padLeft}#{params}>|] - where - paramsText = toLazyText params - padLeft = if L.head paramsText == ':' then [lt| |] else mempty - - response mt = response' (payload mt) - where - payload = maybe "void" cppType - response' params = [lt|::bond::comm::message<#{padLeft}#{params}>|] - where - paramsText = toLazyText params - padLeft = if L.head paramsText == ':' then [lt| |] else mempty - - callback m = [lt|const std::function<void (const #{response m}&)>& callback|] - - comm s@Service {..} = [lt|#{template}class #{declName} - { - public: - virtual ~#{declName}() = default; - - #{doubleLineSep 2 virtualMethod serviceMethods} - - struct Schema; - class Proxy; - - template <template <typename> class Promise> - class Using; - }; - - #{template}struct #{className}::Schema - { - #{export_attr}static const ::bond::Metadata metadata; - - #{newlineSep 2 methodMetadata serviceMethods} - - public: struct service - { - #{doubleLineSep 3 methodTemplate serviceMethods} - }; - - private: typedef boost::mpl::list<> methods0; - #{newlineSep 2 pushMethod indexedMethods} - - public: typedef #{typename}methods#{length serviceMethods}::type methods; - #{constructor} - }; - #{onlyTemplate $ CPP.schemaMetadata cpp s} - - #{template}class #{className}::Proxy - : public #{className} - { - public: - template <typename ServiceProxy> - explicit - Proxy(const ServiceProxy& proxy, - const std::string& name = #{className}::Schema::metadata.qualified_name) - : _impl(boost::make_shared<__Impl<ServiceProxy>>(proxy, name)) - {} - - explicit - Proxy(const boost::shared_ptr<#{className}>& service) - : _impl(service) - {} - - Proxy() = default; - - #{doubleLineSep 2 proxyMethod serviceMethods} - - template <template <typename> class Promise> - class Using; - - protected: - boost::shared_ptr<#{className}> _impl; - - template <typename ServiceProxy> - class __Impl - : public #{className} - { - public: - __Impl(const ServiceProxy& proxy, const std::string& name) - : _proxy(proxy), - _name(name) - {} - - virtual ~__Impl() = default; - - #{doubleLineSep 3 implMethod serviceMethods} - - private: - ServiceProxy _proxy; - const std::string _name; - }; - }; - - #{template}template <template <typename> class Promise> - class #{className}::Using - : public #{className} - { - public: - #{doubleLineSep 2 virtualFutureMethod serviceMethods} - - #{doubleLineSep 2 serviceMethod serviceMethods} - }; - - #{template}template <template <typename> class Promise> - class #{className}::Proxy::Using - : public #{className}::Proxy - { - public: - template <typename ServiceProxy> - explicit - Using(const ServiceProxy& proxy, - const std::string& name = #{className}::Schema::metadata.qualified_name) - : #{className}::Proxy(proxy, name) - {} - - explicit - Using(const boost::shared_ptr<#{className}>& service) - : #{className}::Proxy(service) - {} - - Using() = default; - - #{doubleLineSep 2 proxyFutureMethod serviceMethods} - }; - |] - where - className = CPP.className s - template = CPP.template s - onlyTemplate x = if null declParams then mempty else x - typename = onlyTemplate [lt|typename |] - - export_attr = optional (\a -> [lt|#{a} - |]) export_attribute - - methodMetadataVar m = [lt|s_#{methodName m}_metadata|] - - methodMetadata m = - [lt|private: #{export_attr}static const ::bond::Metadata #{methodMetadataVar m};|] - - -- reversed list of method names zipped with indexes - indexedMethods :: [(String, Int)] - indexedMethods = zipWith ((,) . methodName) (reverse serviceMethods) [0..] - - pushMethod (method, i) = - [lt|private: typedef #{typename}boost::mpl::push_front<methods#{i}, #{typename}service::#{method}>::type methods#{i + 1};|] - - -- constructor, generated only for service templates - constructor = onlyTemplate [lt| - Schema() - { - // Force instantiation of template statics - (void)metadata; - #{newlineSep 4 static serviceMethods} - }|] - where - static m = [lt|(void)#{methodMetadataVar m};|] - - methodTemplate m = [lt|typedef ::bond::reflection::MethodTemplate< - #{className}, - #{request $ methodInput m}, - #{result m}, - &#{className}::#{methodName m}, - &#{methodMetadataVar m} - > #{methodName m};|] - where - result Event{} = "void" - result Function{..} = response methodResult - - methodSignature n m = - [lt|void #{methodName m}(#{commaLineSep n id $ methodParams m})|] - where - methodParams Event{..} = - [ [lt|const #{request methodInput}& input|] - ] - - methodParams Function{..} = - [ [lt|const #{request methodInput}& input|] - , callback methodResult - ] - - resultOf x f = [lt|decltype(std::declval< #{x}>().#{f}())|] - - promiseType result = [lt|Promise< #{response result}>|] - - futureType result = resultOf (promiseType result) get_future - where - get_future = [lt|get_future|] - - methodFutureSignature Function{..} = - [lt|auto #{methodName}(const #{request methodInput}& input) - -> #{futureType methodResult}|] - methodFutureSignature Event{..} = error "No future-based signature for Event methods" - - virtualMethod m = [lt|virtual #{methodSignature 3 m} = 0;|] - - virtualFutureMethod Event{} = mempty - virtualFutureMethod m = [lt|virtual #{methodFutureSignature m} = 0;|] - - serviceMethod Event{} = mempty - serviceMethod m@Function{..} = [lt|#{methodSignature 3 m} override - { - when(#{methodName}(input), ::bond::comm::Continuation(callback)); - }|] - - proxyMethod m@Event{..} = [lt|#{methodSignature 3 m} override - { - _impl->#{methodName}(input); - }#{proxyMethodOverload methodInput}|] - where - proxyMethodOverload Nothing = [lt| - - void #{methodName}() - { - _impl->#{methodName}(::bond::comm::payload<void>()); - }|] - proxyMethodOverload (Just payload) | isStruct payload = [lt| - - void #{methodName}(const #{cppType payload}& input) - { - _impl->#{methodName}(boost::cref(input)); - }|] - proxyMethodOverload _ = mempty - - proxyMethod m@Function{..} = [lt|#{methodSignature 3 m} override - { - _impl->#{methodName}(input, callback); - }#{proxyMethodOverload methodInput}|] - where - proxyMethodOverload Nothing = [lt| - - void #{methodName}( - #{callback methodResult}) - { - _impl->#{methodName}(::bond::comm::payload<void>(), callback); - }|] - proxyMethodOverload (Just payload) | isStruct payload = [lt| - - void #{methodName}(const #{cppType payload}& input, - #{callback methodResult}) - { - _impl->#{methodName}(boost::cref(input), callback); - }|] - proxyMethodOverload _ = mempty - - proxyFutureMethod Event{} = mempty - proxyFutureMethod m@Function{..} = [lt|using #{className}::Proxy::#{methodName}; - - #{methodFutureSignature m} - { - auto promise = boost::make_shared<#{promiseType methodResult}>(); - - _impl->#{methodName}(input, - [=](const #{response methodResult}& result) mutable - { - promise->set_value(result); - }); - - return promise->get_future(); - }#{proxyMethodOverload methodInput}|] - where - proxyMethodOverload Nothing = [lt| - - auto #{methodName}() - -> #{futureType methodResult} - { - return #{methodName}(::bond::comm::payload<void>()); - }|] - proxyMethodOverload (Just payload) | isStruct payload = [lt| - - auto #{methodName}(const #{cppType payload}& input) - -> #{futureType methodResult} - { - return #{methodName}(#{request methodInput}(boost::cref(input))); - } - |] - proxyMethodOverload _ = mempty - - implMethod m@Event{..} = [lt|#{methodSignature 4 m} override - { - _proxy.Send(_name, Schema::service::#{methodName}::metadata.name, input); - }|] - - implMethod m@Function{..} = [lt|#{methodSignature 4 m} override - { - _proxy.Send(_name, Schema::service::#{methodName}::metadata.name, input, callback); - }|] - - comm _ = mempty
src/Language/Bond/Codegen/Cpp/Grpc_h.hs view
@@ -6,6 +6,7 @@ module Language.Bond.Codegen.Cpp.Grpc_h (grpc_h) where import System.FilePath +import Data.Maybe (isNothing) import Data.Monoid import Prelude import qualified Data.Text.Lazy as L @@ -27,36 +28,16 @@ #include "#{file}_reflection.h" #include "#{file}_types.h" #{newlineSep 0 includeImport imports} +#{includeBondReflection} #include <bond/core/bonded.h> -#include <bond/ext/grpc/bond_utils.h> -#include <bond/ext/grpc/client_callback.h> -#include <bond/ext/grpc/io_manager.h> #include <bond/ext/grpc/reflection.h> -#include <bond/ext/grpc/thread_pool.h> -#include <bond/ext/grpc/unary_call.h> -#include <bond/ext/grpc/detail/client_call_data.h> +#include <bond/ext/grpc/detail/client.h> #include <bond/ext/grpc/detail/service.h> -#include <bond/ext/grpc/detail/service_call_data.h> #include <boost/optional/optional.hpp> #include <functional> #include <memory> -#ifdef _MSC_VER -#pragma warning (push) -#pragma warning (disable: 4100 4267) -#endif - -#include <grpc++/impl/codegen/channel_interface.h> -#include <grpc++/impl/codegen/client_context.h> -#include <grpc++/impl/codegen/completion_queue.h> -#include <grpc++/impl/codegen/rpc_method.h> -#include <grpc++/impl/codegen/status.h> - -#ifdef _MSC_VER -#pragma warning (pop) -#endif - #{CPP.openNamespace cpp} #{doubleLineSep 1 grpc declarations} @@ -64,13 +45,13 @@ |]) where - includeImport (Import path) = [lt|#include "#{dropExtension path}_grpc.h"|] + includeImport (Import path) = [lt|#include "#{dropExtension (slashForward path)}_grpc.h"|] idl = MappingContext idlTypeMapping [] [] [] cppType = getTypeName cpp - payload = maybe "::bond::Void" cppType + payload = maybe "void" cppType bonded mt = bonded' (payload mt) where @@ -79,100 +60,89 @@ paramsText = toLazyText params padLeft = if L.head paramsText == ':' then [lt| |] else mempty + includeBondReflection = + if usesBondVoid then [lt|#include <bond/core/bond_reflection.h>|] else mempty + where usesBondVoid = any declUses declarations + declUses Service {serviceMethods = methods} = any methodUses methods + declUses _ = False + methodUses Function {methodInput = input} = isNothing (methodTypeToMaybe input) + methodUses Event {} = True + grpc s@Service{..} = [lt| -#{template}class #{declName} final +#{template}struct #{declName} final { -public: - struct Schema; - - template <typename TThreadPool> - class #{proxyName} + struct Schema { - public: - #{proxyName}( - const std::shared_ptr< ::grpc::ChannelInterface>& channel, - std::shared_ptr< ::bond::ext::gRPC::io_manager> ioManager, - std::shared_ptr<TThreadPool> threadPool); + #{export_attr}static const ::bond::Metadata metadata; - #{doubleLineSep 2 publicProxyMethodDecl serviceMethods} + #{newlineSep 2 methodMetadata serviceMethods} - #{proxyName}(const #{proxyName}&) = delete; - #{proxyName}& operator=(const #{proxyName}&) = delete; + public: struct service + { + #{newlineSep 3 methodTemplate serviceMethods} + }; - #{proxyName}(#{proxyName}&&) = default; - #{proxyName}& operator=(#{proxyName}&&) = default; + private: typedef boost::mpl::list<> methods0; + #{newlineSep 2 pushMethod indexedMethods} - private: - std::shared_ptr< ::grpc::ChannelInterface> _channel; - std::shared_ptr< ::bond::ext::gRPC::io_manager> _ioManager; - std::shared_ptr<TThreadPool> _threadPool; + public: typedef #{typename}methods#{length serviceMethods}::type methods; - #{doubleLineSep 2 privateProxyMethodDecl serviceMethods} + #{constructor} }; - using Client = #{proxyName}< ::bond::ext::gRPC::thread_pool>; - - template <typename TThreadPool> - class #{serviceName} : public ::bond::ext::gRPC::detail::service<TThreadPool> + class #{proxyName} : public ::bond::ext::grpc::detail::client { public: - #{serviceName}() - { - #{newlineSep 3 serviceAddMethod serviceMethods} - } - - virtual ~#{serviceName}() { } - #{serviceStartMethod} + using ::bond::ext::grpc::detail::client::client; - #{newlineSep 2 serviceVirtualMethod serviceMethods} + #{doubleLineSep 2 publicProxyMethodDecl serviceMethods} private: - #{newlineSep 2 serviceMethodReceiveData serviceMethods} + #{newlineSep 2 privateProxyMethodDecl serviceMethods} }; - using Service = #{serviceName}< ::bond::ext::gRPC::thread_pool>; -}; + class #{serviceName} : public ::bond::ext::grpc::detail::service + { + public: + explicit #{serviceName}(const ::bond::ext::grpc::Scheduler& scheduler) + : ::bond::ext::grpc::detail::service( + scheduler, + { + #{commaLineSep 5 serviceMethodName serviceMethods} + }) + {} -#{template}template <typename TThreadPool> -inline #{className}::#{proxyName}<TThreadPool>::#{proxyName}( - const std::shared_ptr< ::grpc::ChannelInterface>& channel, - std::shared_ptr< ::bond::ext::gRPC::io_manager> ioManager, - std::shared_ptr<TThreadPool> threadPool) - : _channel(channel) - , _ioManager(ioManager) - , _threadPool(threadPool) - #{newlineSep 1 proxyMethodMemberInit serviceMethods} - { } + #{newlineSep 2 serviceVirtualMethod serviceMethods} -#{doubleLineSep 0 methodDecl serviceMethods} + private: + void start() override + { + _data.emplace(*this); + } -#{template}struct #{className}::Schema -{ - #{export_attr}static const ::bond::Metadata metadata; + struct data + { + explicit data(#{serviceName}& s) + : _s(s) + {} - #{newlineSep 1 methodMetadata serviceMethods} + #{serviceName}& _s; + #{newlineSep 3 serviceDataMember serviceMethodsWithIndex} + }; - public: struct service - { - #{doubleLineSep 2 methodTemplate serviceMethods} + ::boost::optional<data> _data; }; - - private: typedef boost::mpl::list<> methods0; - #{newlineSep 1 pushMethod indexedMethods} - - public: typedef #{typename}methods#{length serviceMethods}::type methods; - - #{constructor} }; + #{onlyTemplate $ CPP.schemaMetadata cpp s} |] where - className = CPP.className s template = CPP.template s onlyTemplate x = if null declParams then mempty else x + onlyNonTemplate x = if null declParams then x else mempty typename = onlyTemplate [lt|typename |] - export_attr = optional (\a -> [lt|#{a} + export_attr = onlyNonTemplate $ optional (\a -> [lt|#{a} |]) export_attribute methodMetadataVar m = [lt|s_#{methodName m}_metadata|] @@ -197,157 +167,60 @@ where static m = [lt|(void)#{methodMetadataVar m};|] - methodTemplate m = [lt|typedef ::bond::ext::gRPC::reflection::MethodTemplate< - #{className}, - #{bonded $ methodInput m}, - #{result m}, - &#{methodMetadataVar m} - > #{methodName m};|] - where - result Event{} = "void" - result Function{..} = bonded methodResult - - proxyName = "ClientCore" :: String - serviceName = "ServiceCore" :: String + methodTemplate m = [lt|typedef struct : ::bond::ext::grpc::reflection::MethodTemplate<#{declName}, #{payload $ methodTypeToMaybe (methodInput m)}, #{resultType m}, &#{methodMetadataVar m}> {} #{methodName m};|] - methodNames :: [String] - methodNames = map methodName serviceMethods + proxyName = "Client" :: String + serviceName = "Service" :: String serviceMethodsWithIndex :: [(Integer,Method)] serviceMethodsWithIndex = zip [0..] serviceMethods - publicProxyMethodDecl Function{methodInput = Nothing, ..} = [lt|void Async#{methodName}(::std::shared_ptr< ::grpc::ClientContext> context, const std::function<void(std::shared_ptr< ::bond::ext::gRPC::unary_call_result< #{payload methodResult}>>)>& cb); - void Async#{methodName}(const std::function<void(std::shared_ptr< ::bond::ext::gRPC::unary_call_result< #{payload methodResult}>>)>& cb) + publicProxyMethodDecl Function{methodInput = Void, ..} = [lt|void Async#{methodName}(const ::std::function<void(::bond::ext::grpc::unary_call_result<#{payload (methodTypeToMaybe methodResult)}>)>& cb, ::std::shared_ptr<::grpc::ClientContext> context = {}) { - Async#{methodName}(::std::make_shared< ::grpc::ClientContext>(), cb); + ::bond::ext::grpc::detail::client::dispatch(_m#{methodName}, std::move(context), cb); + } + ::std::future<::bond::ext::grpc::unary_call_result<#{payload (methodTypeToMaybe methodResult)}>> Async#{methodName}(::std::shared_ptr<::grpc::ClientContext> context = {}) + { + return ::bond::ext::grpc::detail::client::dispatch<#{payload (methodTypeToMaybe methodResult)}>(_m#{methodName}, std::move(context)); }|] - publicProxyMethodDecl Function{..} = [lt|void Async#{methodName}(::std::shared_ptr< ::grpc::ClientContext> context, const #{bonded methodInput}& request, const std::function<void(std::shared_ptr< ::bond::ext::gRPC::unary_call_result< #{payload methodResult}>>)>& cb); - void Async#{methodName}(::std::shared_ptr< ::grpc::ClientContext> context, const #{payload methodInput}& request, const std::function<void(std::shared_ptr< ::bond::ext::gRPC::unary_call_result< #{payload methodResult}>>)>& cb) + publicProxyMethodDecl Function{..} = [lt|void Async#{methodName}(const #{bonded (methodTypeToMaybe methodInput)}& request, const ::std::function<void(::bond::ext::grpc::unary_call_result<#{payload (methodTypeToMaybe methodResult)}>)>& cb, ::std::shared_ptr<::grpc::ClientContext> context = {}) { - Async#{methodName}(context, #{bonded methodInput}{request}, cb); + ::bond::ext::grpc::detail::client::dispatch(_m#{methodName}, std::move(context), cb, request); } - void Async#{methodName}(const #{bonded methodInput}& request, const std::function<void(std::shared_ptr< ::bond::ext::gRPC::unary_call_result< #{payload methodResult}>>)>& cb) + std::future<::bond::ext::grpc::unary_call_result<#{payload (methodTypeToMaybe methodResult)}>> Async#{methodName}(const #{bonded (methodTypeToMaybe methodInput)}& request, ::std::shared_ptr<::grpc::ClientContext> context = {}) { - Async#{methodName}(::std::make_shared< ::grpc::ClientContext>(), request, cb); + return ::bond::ext::grpc::detail::client::dispatch<#{payload (methodTypeToMaybe methodResult)}>(_m#{methodName}, std::move(context), request); } - void Async#{methodName}(const #{payload methodInput}& request, const std::function<void(std::shared_ptr< ::bond::ext::gRPC::unary_call_result< #{payload methodResult}>>)>& cb) + void Async#{methodName}(const #{payload (methodTypeToMaybe methodInput)}& request, const ::std::function<void(::bond::ext::grpc::unary_call_result<#{payload (methodTypeToMaybe methodResult)}>)>& cb, ::std::shared_ptr<::grpc::ClientContext> context = {}) { - Async#{methodName}(::std::make_shared< ::grpc::ClientContext>(), #{bonded methodInput}{request}, cb); - }|] - publicProxyMethodDecl Event{methodInput = Nothing, ..} = [lt|void Async#{methodName}(::std::shared_ptr< ::grpc::ClientContext> context); - void Async#{methodName}() + ::bond::ext::grpc::detail::client::dispatch(_m#{methodName}, std::move(context), cb, request); + } + ::std::future<::bond::ext::grpc::unary_call_result<#{payload (methodTypeToMaybe methodResult)}>> Async#{methodName}(const #{payload (methodTypeToMaybe methodInput)}& request, ::std::shared_ptr<::grpc::ClientContext> context = {}) { - Async#{methodName}(::std::make_shared< ::grpc::ClientContext>()); + return ::bond::ext::grpc::detail::client::dispatch<#{payload (methodTypeToMaybe methodResult)}>(_m#{methodName}, std::move(context), request); }|] - publicProxyMethodDecl Event{..} = [lt|void Async#{methodName}(::std::shared_ptr< ::grpc::ClientContext> context, const #{bonded methodInput}& request); - void Async#{methodName}(::std::shared_ptr< ::grpc::ClientContext> context, const #{payload methodInput}& request) + publicProxyMethodDecl Event{methodInput = Void, ..} = [lt|void Async#{methodName}(::std::shared_ptr<::grpc::ClientContext> context = {}) { - Async#{methodName}(context, #{bonded methodInput}{request}); - } - void Async#{methodName}(const #{bonded methodInput}& request) + ::bond::ext::grpc::detail::client::dispatch(_m#{methodName}, std::move(context), {}); + }|] + publicProxyMethodDecl Event{..} = [lt|void Async#{methodName}(const #{bonded (methodTypeToMaybe methodInput)}& request, ::std::shared_ptr<::grpc::ClientContext> context = {}) { - Async#{methodName}(::std::make_shared< ::grpc::ClientContext>(), request); + ::bond::ext::grpc::detail::client::dispatch(_m#{methodName}, std::move(context), {}, request); } - void Async#{methodName}(const #{payload methodInput}& request) + void Async#{methodName}(const #{payload (methodTypeToMaybe methodInput)}& request, ::std::shared_ptr<::grpc::ClientContext> context = {}) { - Async#{methodName}(::std::make_shared< ::grpc::ClientContext>(), #{bonded methodInput}{request}); + ::bond::ext::grpc::detail::client::dispatch(_m#{methodName}, std::move(context), {}, request); }|] - privateProxyMethodDecl Function{..} = [lt|const ::grpc::RpcMethod rpcmethod_#{methodName}_;|] - privateProxyMethodDecl Event{..} = [lt|const ::grpc::RpcMethod rpcmethod_#{methodName}_;|] - - proxyMethodMemberInit Function{..} = [lt|, rpcmethod_#{methodName}_("/#{getDeclTypeName idl s}/#{methodName}", ::grpc::RpcMethod::NORMAL_RPC, channel)|] - proxyMethodMemberInit Event{..} = [lt|, rpcmethod_#{methodName}_("/#{getDeclTypeName idl s}/#{methodName}", ::grpc::RpcMethod::NORMAL_RPC, channel)|] - - methodDecl Function{..} = [lt|#{template}template <typename TThreadPool> -inline void #{className}::#{proxyName}<TThreadPool>::Async#{methodName}( - ::std::shared_ptr< ::grpc::ClientContext> context, - #{voidParam methodInput} - const std::function<void(std::shared_ptr< ::bond::ext::gRPC::unary_call_result< #{payload methodResult}>>)>& cb) -{ - #{voidRequest methodInput} - auto calldata = std::make_shared< ::bond::ext::gRPC::detail::client_unary_call_data< #{payload methodInput}, #{payload methodResult}, TThreadPool>>( - _channel, - _ioManager, - _threadPool, - context, - cb); - calldata->dispatch(rpcmethod_#{methodName}_, request); -}|] - where - voidRequest Nothing = [lt|auto request = ::bond::bonded< ::bond::Void>{ ::bond::Void()};|] - voidRequest _ = mempty - voidParam Nothing = mempty - voidParam _ = [lt|const #{bonded methodInput}& request,|] - - methodDecl Event{..} = [lt|#{template}template <typename TThreadPool> -inline void #{className}::#{proxyName}<TThreadPool>::Async#{methodName}( - ::std::shared_ptr< ::grpc::ClientContext> context - #{voidParam methodInput}) -{ - #{voidRequest methodInput} - auto calldata = std::make_shared< ::bond::ext::gRPC::detail::client_unary_call_data< #{payload methodInput}, #{payload Nothing}, TThreadPool>>( - _channel, - _ioManager, - _threadPool, - context); - calldata->dispatch(rpcmethod_#{methodName}_, request); -}|] - where - voidRequest Nothing = [lt|auto request = ::bond::bonded< ::bond::Void>{ ::bond::Void()};|] - voidRequest _ = mempty - voidParam Nothing = mempty - voidParam _ = [lt|, const #{bonded methodInput}& request|] - - serviceAddMethod Function{..} = [lt|this->AddMethod("/#{getDeclTypeName idl s}/#{methodName}");|] - serviceAddMethod Event{..} = [lt|this->AddMethod("/#{getDeclTypeName idl s}/#{methodName}");|] - - serviceStartMethod = [lt|virtual void start( - ::grpc::ServerCompletionQueue* #{cqParam}, - std::shared_ptr<TThreadPool> #{tpParam}) override - { - BOOST_ASSERT(#{cqParam}); - BOOST_ASSERT(#{tpParam}); - - #{newlineSep 3 initMethodReceiveData serviceMethodsWithIndex} + privateProxyMethodDecl f = [lt|const ::bond::ext::grpc::detail::client::Method _m#{methodName f}{ ::bond::ext::grpc::detail::client::make_method("/#{getDeclTypeName idl s}/#{methodName f}") };|] - #{newlineSep 3 queueReceive serviceMethodsWithIndex} - }|] - where cqParam = uniqueName "cq" methodNames - tpParam = uniqueName "tp" methodNames - initMethodReceiveData (index,Function{..}) = [lt|#{serviceRdMember methodName}.emplace( - this, - #{index}, - #{cqParam}, - #{tpParam}, - std::bind(&#{serviceName}::#{methodName}, this, std::placeholders::_1));|] - initMethodReceiveData (index,Event{..}) = [lt|#{serviceRdMember methodName}.emplace( - this, - #{index}, - #{cqParam}, - #{tpParam}, - std::bind(&#{serviceName}::#{methodName}, this, std::placeholders::_1));|] - queueReceive (index,Function{..}) = [lt|this->queue_receive( - #{index}, - &#{serviceRdMember methodName}->_receivedCall->context(), - &#{serviceRdMember methodName}->_receivedCall->request(), - &#{serviceRdMember methodName}->_receivedCall->responder(), - #{cqParam}, - &#{serviceRdMember methodName}.get());|] - queueReceive (index,Event{..}) = [lt|this->queue_receive( - #{index}, - &#{serviceRdMember methodName}->_receivedCall->context(), - &#{serviceRdMember methodName}->_receivedCall->request(), - &#{serviceRdMember methodName}->_receivedCall->responder(), - #{cqParam}, - &#{serviceRdMember methodName}.get());|] + serviceMethodName f = [lt|"/#{getDeclTypeName idl s}/#{methodName f}"|] - serviceMethodReceiveData Function{..} = [lt|::boost::optional< ::bond::ext::gRPC::detail::service_unary_call_data< #{bonded methodInput}, #{payload methodResult}, TThreadPool>> #{serviceRdMember methodName};|] - serviceMethodReceiveData Event{..} = [lt|::boost::optional< ::bond::ext::gRPC::detail::service_unary_call_data< #{bonded methodInput}, #{payload Nothing}, TThreadPool>> #{serviceRdMember methodName};|] + serviceDataMember (index,f) = [lt|::bond::ext::grpc::detail::service::Method _m#{index}{ _s, #{index}, ::bond::ext::grpc::detail::service::make_callback(&#{serviceName}::#{methodName f}, _s) };|] - serviceVirtualMethod Function{..} = [lt|virtual void #{methodName}(::bond::ext::gRPC::unary_call< #{bonded methodInput}, #{payload methodResult}>) = 0;|] - serviceVirtualMethod Event{..} = [lt|virtual void #{methodName}(::bond::ext::gRPC::unary_call< #{bonded methodInput}, #{payload Nothing}>) = 0;|] + serviceVirtualMethod f = [lt|virtual void #{methodName f}(::bond::ext::grpc::unary_call<#{payload $ methodTypeToMaybe $ methodInput f}, #{resultType f}>) = 0;|] - serviceRdMember methodName = uniqueName ("_rd_" ++ methodName) methodNames + resultType Function{..} = payload (methodTypeToMaybe methodResult) + resultType Event{} = "::bond::reflection::nothing" grpc _ = mempty
src/Language/Bond/Codegen/Cpp/Reflection_h.hs view
@@ -37,7 +37,7 @@ cppType = getTypeName cpp -- template for generating #include statement from import - include (Import path) = [lt|#include "#{dropExtension path}_reflection.h"|] + include (Import path) = [lt|#include "#{dropExtension (slashForward path)}_reflection.h"|] -- template for generating struct schema schema s@Struct {..} = [lt|// @@ -72,10 +72,11 @@ className = CPP.className s - export_attr = optional (\a -> [lt|#{a} + export_attr = onlyNonTemplate $ optional (\a -> [lt|#{a} |]) export_attribute onlyTemplate x = if null declParams then mempty else x + onlyNonTemplate x = if null declParams then x else mempty metadataInitArgs = onlyTemplate [lt|<boost::mpl::list#{classParams} >|]
src/Language/Bond/Codegen/Cpp/Types_cpp.hs view
@@ -20,12 +20,15 @@ types_cpp cpp file _imports declarations = ("_types.cpp", [lt| #include "#{file}_reflection.h" #include <bond/core/exception.h> - +#{unorderedMapInclude} #{CPP.openNamespace cpp} #{doubleLineSepEnd 1 statics declarations} #{CPP.closeNamespace cpp} |]) where + unorderedMapInclude = if not (any CPP.isEnumDeclaration declarations) then mempty else [lt|#include <unordered_map> +|] + -- definitions of Schema statics for non-generic structs statics s@Struct {..} = if null declParams then CPP.schemaMetadata cpp s else mempty @@ -35,26 +38,43 @@ -- ToString is intentionally not implemented in terms of FromEnum, as -- ToString returns a reference to the name stored in the map. FromEnum -- copies this name into the output paramater. - statics Enum {..} = [lt| + statics e@Enum {..} = [lt| namespace _bond_enumerators { namespace #{declName} { - const - std::map<std::string, enum #{declName}> _name_to_value_#{declName} = - boost::assign::map_list_of<std::string, enum #{declName}> - #{newlineSep 4 constant enumConstants}; - - const - std::map<enum #{declName}, std::string> _value_to_name_#{declName} = - ::bond::reverse_map(_name_to_value_#{declName}); +#if defined(_MSC_VER) && (_MSC_VER < 1900) + const std::map<std::string, enum #{declName}> _name_to_value_#{declName} + { + #{CPP.enumNameToValueInitList 4 e} + }; + const std::map<enum #{declName}, std::string> _value_to_name_#{declName} + { + #{CPP.enumValueToNameInitList 4 e} + }; +#else + namespace + { + struct _hash_#{declName} + { + std::size_t operator()(enum #{declName} value) const + { + return static_cast<std::size_t>(value); + } + }; + } +#endif const std::string& ToString(enum #{declName} value) { - std::map<enum #{declName}, std::string>::const_iterator it = - GetValueToNameMap(value).find(value); +#if defined(_MSC_VER) && (_MSC_VER < 1900) + const auto& map = GetValueToNameMap(value); +#else + const auto& map = GetValueToNameMap<std::unordered_map<enum #{declName}, std::string, _hash_#{declName}> >(value); +#endif + auto it = map.find(value); - if (GetValueToNameMap(value).end() == it) + if (map.end() == it) ::bond::InvalidEnumValueException(value, "#{declName}"); return it->second; @@ -65,9 +85,42 @@ if (!ToEnum(value, name)) ::bond::InvalidEnumValueException(name.c_str(), "#{declName}"); } + + bool ToEnum(enum #{declName}& value, const std::string& name) + { +#if defined(_MSC_VER) && (_MSC_VER < 1900) + const auto& map = GetNameToValueMap(value); +#else + const auto& map = GetNameToValueMap<std::unordered_map<std::string, enum #{declName}> >(value); +#endif + auto it = map.find(name); + + if (map.end() == it) + return false; + + value = it->second; + + return true; + } + + bool FromEnum(std::string& name, enum #{declName} value) + { +#if defined(_MSC_VER) && (_MSC_VER < 1900) + const auto& map = GetValueToNameMap(value); +#else + const auto& map = GetValueToNameMap<std::unordered_map<enum #{declName}, std::string, _hash_#{declName}> >(value); +#endif + auto it = map.find(value); + + if (map.end() == it) + return false; + + name = it->second; + + return true; + } + } // namespace #{declName} } // namespace _bond_enumerators|] - where - constant Constant {..} = [lt|("#{constantName}", #{constantName})|] statics _ = mempty
src/Language/Bond/Codegen/Cpp/Types_h.hs view
@@ -26,16 +26,20 @@ -- | Codegen template for generating /base_name/_type.h containing definitions -- of C++ types representing the schema. -types_h :: [String] -- ^ list of optional header files to be @#include@'ed by the generated code +types_h :: Maybe String -- ^ Optional attribute to decorate the enum conversion function declarations + -> [String] -- ^ list of optional header files to be @#include@'ed by the generated code -> Bool -- ^ 'True' to generate enum definitions into a separate file /base_name/_enum.h -> Maybe String -- ^ optional custom allocator to be used in the generated code + -> Bool -- ^ 'True' to generate constructors with allocator + -> Bool -- ^ 'True' to generate type aliases + -> Bool -- ^ 'True' to use std::scoped_allocator_adaptor for strings and containers -> MappingContext -> String -> [Import] -> [Declaration] -> (String, L.Text) -types_h userHeaders enumHeader allocator cpp file imports declarations = ("_types.h", [lt| +types_h export_attribute userHeaders enumHeader allocator alloc_ctors_enabled type_aliases_enabled scoped_alloc_enabled cpp file imports declarations = ("_types.h", [lt| #pragma once #{newlineBeginSep 0 includeHeader userHeaders} #include <bond/core/bond_version.h> -#if BOND_VERSION < 0x0700 +#if BOND_VERSION < 0x0800 #error This file was generated by a newer version of the Bond compiler and is incompatible with your version of the Bond library. #endif @@ -49,19 +53,26 @@ #{includeEnum} #{newlineSepEnd 0 includeImport imports} #{CPP.openNamespace cpp} - #{doubleLineSep 1 typeDeclaration declarations} + #{doubleLineSepEnd 1 id $ catMaybes $ aliasDeclarations}#{doubleLineSep 1 typeDeclaration declarations} #{CPP.closeNamespace cpp} -#{optional usesAllocatorSpecialization allocator} |]) where + aliasDeclarations = if type_aliases_enabled then map aliasDeclName declarations else [] + + aliasDeclName a@Alias {..} = Just [lt|#{CPP.template a}using #{declName} = #{getAliasDeclTypeName cpp a};|] + aliasDeclName _ = Nothing + hexVersion (Version xs _) = foldr showHex "" xs cppType = getTypeName cpp + cppExpandAliases = if type_aliases_enabled then cpp { typeMapping = cppExpandAliasesTypeMapping $ typeMapping cpp } else cpp + cppTypeExpandAliases = getTypeName cppExpandAliases + idl = MappingContext idlTypeMapping [] [] [] cppDefaultValue = CPP.defaultValue cpp - includeImport (Import path) = [lt|#include "#{dropExtension path}_types.h"|] + includeImport (Import path) = [lt|#include "#{dropExtension (slashForward path)}_types.h"|] optionalHeader (False, _) = mempty optionalHeader (True, header) = includeHeader header @@ -85,29 +96,14 @@ anyNullable = Any . isNullable + anyStringOrContainer f = Any (isString f || isMetaName f || isContainer f) + bondHeaders :: [(Bool, String)] bondHeaders = [ (have anyNullable, "<bond/core/nullable.h>"), (have anyBonded, "<bond/core/bonded.h>"), - (have anyBlob, "<bond/core/blob.h>")] - - usesAllocatorSpecialization alloc = [lt| -#if !defined(BOND_NO_CXX11_ALLOCATOR) -namespace std -{ - #{doubleLineSep 1 usesAllocator declarations} -} -#endif -|] - where - usesAllocator s@Struct {..} = [lt|template <typename _Alloc#{sepBeginBy ", typename " paramName declParams}> - struct uses_allocator<#{typename} #{getDeclTypeName cpp s}#{CPP.classParams s}, _Alloc> - : is_convertible<_Alloc, #{allocParam}> - {};|] - where - typename = if null declParams then mempty else [lt|typename|] - allocParam = if last alloc == '>' then alloc ++ " " else alloc - usesAllocator _ = mempty + (have anyBlob, "<bond/core/blob.h>"), + (scoped_alloc_enabled && have anyStringOrContainer, "<scoped_allocator>")] -- forward declaration typeDeclaration f@Forward {..} = [lt|#{CPP.template f}struct #{declName};|] @@ -116,10 +112,10 @@ typeDeclaration s@Struct {..} = [lt| #{template}struct #{declName}#{optional base structBase} { - #{newlineSepEnd 2 field structFields}#{defaultCtor} + #{optional allocatorType allocator}#{newlineSepEnd 2 field structFields}#{defaultCtor} - #{copyCtor} - #{moveCtor} + #{copyCtor}#{ifThenElse alloc_ctors_enabled (optional allocatorCopyCtor allocator) mempty} + #{moveCtor}#{ifThenElse alloc_ctors_enabled (optional allocatorMoveCtor allocator) mempty} #{optional allocatorCtor allocator} #{assignmentOp} @@ -207,8 +203,10 @@ }|] needAlloc alloc = isJust structBase || any (allocParameterized alloc . fieldType) structFields - allocParameterized alloc t = (isStruct t) || (L.isInfixOf (L.pack alloc) . toLazyText $ cppType t) + allocParameterized alloc (BT_Nullable t) = allocParameterized alloc t + allocParameterized alloc t = (isStruct t) || (L.isInfixOf (L.pack alloc) $ toLazyText $ cppTypeExpandAliases t) + -- default constructor defaultCtor = [lt| #{dummyTemplateTag}#{declName}(#{vc12WorkaroundParam})#{initList}#{ctorBody}|] @@ -228,6 +226,10 @@ fieldInit Field {..} = optional (\x -> [lt|#{fieldName}(#{x})|]) $ initValue fieldType fieldDefault + allocatorType alloc = [lt|using allocator_type = #{alloc}; + + |] + allocatorCtor alloc = [lt| explicit #{declName}(const #{alloc}&#{allocParam})#{initList}#{ctorBody} @@ -248,19 +250,14 @@ allocInitValue t (Just d) | isString t = Just [lt|#{cppDefaultValue t d}, allocator|] allocInitValue t Nothing - | isList t || isMetaName t || isString t || isStruct t = Just "allocator" - | isAssociative t = Just [lt|std::less<#{keyType t}>(), allocator|] + | isContainer t || isMetaName t || isString t || isStruct t = Just "allocator" allocInitValue t d = initValue t d - keyType (BT_Set key) = cppType key - keyType (BT_Map key _) = cppType key - keyType (BT_UserDefined a@Alias {} args) = keyType $ resolveAlias a args - keyType _ = error "allocatorCtor/keyType: impossible happened." -- copy constructor copyCtor = if hasMetaFields then define else implicitlyDeclared where -- default OK when there are no meta fields - implicitlyDeclared = CPP.ifndef CPP.defaultedFunctions [lt| + implicitlyDeclared = [lt| // Compiler generated copy ctor OK #{declName}(const #{declName}&) = default;|] @@ -276,18 +273,45 @@ getAllocator BT_MetaFullName = [lt|.get_allocator()|] getAllocator _ = mempty + -- copy/move constructor with allocator + allocatorCopyOrMoveCtor otherParamDecl otherParamValue alloc = [lt| + + #{declName}(#{otherParamDecl declName}#{otherParam}, const #{alloc}&#{allocParam})#{initList}#{ctorBody}|] + where + allocParam = if needAlloc alloc then [lt| allocator|] else mempty + + initList = initializeList + (optional baseInit structBase) + (commaLineSep 3 fieldInit structFields) + baseInit b = [lt|#{cppType b}(#{otherParamValue $ L.pack otherParamName}, allocator)|] + + fieldRef fieldName = [lt|#{otherParamName}.#{fieldName}|] + fieldInit Field {..} = [lt|#{fieldName}(#{otherParamValue $ fieldRef fieldName}#{allocInitValueText fieldType})|] + + allocInitValueText fieldType = optional (\x -> [lt|, #{x}|]) + $ allocInitValue fieldType + allocInitValue t@(BT_UserDefined a@Alias {} args) + | allocParameterized alloc t = allocInitValue (resolveAlias a args) + | otherwise = Nothing + allocInitValue (BT_Nullable t) = allocInitValue t + allocInitValue (BT_Maybe t) = allocInitValue t + allocInitValue t + | isList t || isMetaName t || isString t || isStruct t || isAssociative t = Just [lt|allocator|] + | otherwise = Nothing + + -- copy constructor with allocator + allocatorCopyCtor alloc = allocatorCopyOrMoveCtor (\f -> [lt|const #{f}&|]) id alloc + -- move constructor moveCtor = if hasMetaFields then [lt| -#if !defined(#{CPP.rvalueReferences}) - #{explicit} -#endif|] + #{explicit}|] -- even if implicit would be okay, fall back to explicit for -- compilers that don't support = default for move constructors else [lt| -#if !defined(#{CPP.defaultedMoveCtors}) - #{implicit} -#elif !defined(#{CPP.rvalueReferences}) +#if defined(_MSC_VER) && (_MSC_VER < 1900) // Versions of MSVC prior to 1900 do not support = default for move ctors #{explicit} +#else + #{implicit} #endif|] where -- default OK when there are no meta fields @@ -303,18 +327,26 @@ fieldMove Field {..} = [lt|#{fieldName}(std::move(#{otherParamName}.#{fieldName}))|] param = if initList == mempty then mempty else ' ':otherParamName + -- move constructor with allocator + allocatorMoveCtor alloc = (allocatorCopyOrMoveCtor (\f -> [lt|#{f}&&|]) (\f -> [lt|std::move(#{f})|]) alloc) + -- operator= assignmentOp = if hasMetaFields then define else implicitlyDeclared where -- default OK when there are no meta fields - implicitlyDeclared = CPP.ifndef CPP.defaultedFunctions [lt| + implicitlyDeclared = [lt| +#if defined(_MSC_VER) && (_MSC_VER < 1900) // Versions of MSVC prior to 1900 do not support = default for move ctors + #{define} +#else // Compiler generated operator= OK - #{declName}& operator=(const #{declName}&) = default;|] + #{declName}& operator=(const #{declName}&) = default; + #{declName}& operator=(#{declName}&&) = default; +#endif|] -- define operator= using swap - define = [lt|#{declName}& operator=(const #{declName}& #{otherParamName}) + define = [lt|#{declName}& operator=(#{declName} #{otherParamName}) { - #{declName}(#{otherParamName}).swap(*this); + #{otherParamName}.swap(*this); return *this; }|] @@ -344,64 +376,59 @@ namespace #{declName} { #{enumDefinition} - extern const std::map<enum #{declName}, std::string> _value_to_name_#{declName}; - extern const std::map<std::string, enum #{declName}> _name_to_value_#{declName}; - - inline - const char* GetTypeName(enum #{declName}) + inline BOND_CONSTEXPR const char* GetTypeName(enum #{declName}) { return "#{declName}"; } - inline - const char* GetTypeName(enum #{declName}, const ::bond::qualified_name_tag&) + inline BOND_CONSTEXPR const char* GetTypeName(enum #{declName}, const ::bond::qualified_name_tag&) { return "#{getDeclTypeName idl e}"; } - inline - const std::map<enum #{declName}, std::string>& GetValueToNameMap(enum #{declName}) +#if defined(_MSC_VER) && (_MSC_VER < 1900) // Versions of MSVC prior to 1900 do not support magic statics + extern const std::map<enum #{declName}, std::string> _value_to_name_#{declName}; + + inline const std::map<enum #{declName}, std::string>& GetValueToNameMap(enum #{declName}) { return _value_to_name_#{declName}; } - inline - const std::map<std::string, enum #{declName}>& GetNameToValueMap(enum #{declName}) + extern const std::map<std::string, enum #{declName}> _name_to_value_#{declName}; + + inline const std::map<std::string, enum #{declName}>& GetNameToValueMap(enum #{declName}) { return _name_to_value_#{declName}; } - - const std::string& ToString(enum #{declName} value); - - void FromString(const std::string& name, enum #{declName}& value); - - inline - bool ToEnum(enum #{declName}& value, const std::string& name) +#else + template <typename Map = std::map<enum #{declName}, std::string> > + inline const Map& GetValueToNameMap(enum #{declName}, ::bond::detail::mpl::identity<Map> = {}) { - std::map<std::string, enum #{declName}>::const_iterator it = - _name_to_value_#{declName}.find(name); - - if (_name_to_value_#{declName}.end() == it) - return false; - - value = it->second; - - return true; + static const Map s_valueToNameMap + { + #{CPP.enumValueToNameInitList 5 e} + }; + return s_valueToNameMap; } - inline - bool FromEnum(std::string& name, enum #{declName} value) + template <typename Map = std::map<std::string, enum #{declName}> > + inline const Map& GetNameToValueMap(enum #{declName}, ::bond::detail::mpl::identity<Map> = {}) { - std::map<enum #{declName}, std::string>::const_iterator it = - _value_to_name_#{declName}.find(value); + static const Map s_nameToValueMap + { + #{CPP.enumNameToValueInitList 5 e} + }; + return s_nameToValueMap; + } +#endif + #{export_attr}const std::string& ToString(enum #{declName} value); - if (_value_to_name_#{declName}.end() == it) - return false; + #{export_attr}void FromString(const std::string& name, enum #{declName}& value); - name = it->second; + #{export_attr}bool ToEnum(enum #{declName}& value, const std::string& name); - return true; - } + #{export_attr}bool FromEnum(std::string& name, enum #{declName} value); + } // namespace #{declName} } // namespace _bond_enumerators @@ -411,5 +438,6 @@ |] enumUsing = if enumHeader then mempty else [lt|using namespace _bond_enumerators::#{declName}; |] + export_attr = optional (\a -> [lt|#{a} |]) export_attribute typeDeclaration _ = mempty
src/Language/Bond/Codegen/Cpp/Util.hs view
@@ -15,13 +15,14 @@ , defaultValue , attributeInit , schemaMetadata - , ifndef - , defaultedFunctions - , defaultedMoveCtors - , rvalueReferences , enumDefinition + , isEnumDeclaration + , enumValueToNameInitList + , enumNameToValueInitList ) where +import Data.Int (Int64) +import Data.List (sortOn) import Data.Monoid import Prelude import Data.Text.Lazy (Text, unpack) @@ -67,10 +68,14 @@ -- attribute initializer attributeInit :: [Attribute] -> Text attributeInit [] = "::bond::reflection::Attributes()" -attributeInit xs = [lt|boost::assign::map_list_of<std::string, std::string>#{newlineBeginSep 5 attrNameValue xs}|] +attributeInit xs = [lt|{ + #{commaLineSep 5 attrNameValueText sortedAttributes} + }|] where - idl = MappingContext idlTypeMapping [] [] [] - attrNameValue Attribute {..} = [lt|("#{getQualifiedName idl attrName}", "#{attrValue}")|] + idl = MappingContext idlTypeMapping [] [] [] + attrNameValue Attribute {..} = (getQualifiedName idl attrName, attrValue) + sortedAttributes = sortOn fst $ map attrNameValue xs + attrNameValueText (name, value) = [lt|{ "#{name}", "#{value}" }|] -- modifier tag type for a field @@ -147,16 +152,6 @@ #{attributeInit a});|] schemaMetadata _ _ = error "schemaMetadata: impossible happened." -defaultedFunctions, defaultedMoveCtors, rvalueReferences :: Text -defaultedFunctions = [lt|BOND_NO_CXX11_DEFAULTED_FUNCTIONS|] -defaultedMoveCtors = [lt|BOND_NO_CXX11_DEFAULTED_MOVE_CTOR|] -rvalueReferences = [lt|BOND_NO_CXX11_RVALUE_REFERENCES|] - -ifndef :: ToText a => a -> Text -> Text -ifndef m = between [lt| -#ifndef #{m}|] [lt| -#endif|] - enumDefinition :: Declaration -> Text enumDefinition Enum {..} = [lt|enum #{declName} { @@ -167,3 +162,22 @@ value (-2147483648) = [lt| = static_cast<int32_t>(-2147483647-1)|] value x = [lt| = static_cast<int32_t>(#{x})|] enumDefinition _ = error "enumDefinition: impossible happened." + +isEnumDeclaration :: Declaration -> Bool +isEnumDeclaration Enum {} = True +isEnumDeclaration _ = False + + +enumValueToNameInitList :: Int64 -> Declaration -> Text +enumValueToNameInitList n Enum {..} = commaLineSep n valueNameConst enumConstByValue + where + valueNameConst (name, _) = [lt|{ #{name}, "#{name}" }|] + enumConstByValue = sortOn snd $ reifyEnumValues enumConstants +enumValueToNameInitList _ _ = error "enumValueToNameInitList: impossible happened." + +enumNameToValueInitList :: Int64 -> Declaration -> Text +enumNameToValueInitList n Enum {..} = commaLineSep n nameValueConst enumConstByName + where + nameValueConst Constant {..} = [lt|{ "#{constantName}", #{constantName} }|] + enumConstByName = sortOn constantName enumConstants +enumNameToValueInitList _ _ = error "enumNameToValueInitList: impossible happened."
− src/Language/Bond/Codegen/Cs/Comm_cs.hs
@@ -1,209 +0,0 @@--- Copyright (c) Microsoft. All rights reserved. --- Licensed under the MIT license. See LICENSE file in the project root for full license information. - -{-# LANGUAGE QuasiQuotes, OverloadedStrings, RecordWildCards #-} - -module Language.Bond.Codegen.Cs.Comm_cs ( - comm_interface_cs, - comm_proxy_cs, - comm_service_cs) -where - -import Data.Maybe -import Data.Monoid -import Data.List (nub) -import Prelude -import qualified Data.Text.Lazy as L -import Data.Text.Lazy.Builder -import Text.Shakespeare.Text -import Language.Bond.Syntax.Types -import Language.Bond.Util -import Language.Bond.Codegen.Util -import Language.Bond.Codegen.TypeMapping -import qualified Language.Bond.Codegen.Cs.Util as CS - - -getMessageTypeName :: MappingContext -> Maybe Type -> Builder -getMessageTypeName ctx t = maybe "global::Bond.Void" (getTypeName ctx) t - -getMessageProxyInputParam :: MappingContext -> Maybe Type -> Builder -getMessageProxyInputParam ctx t = maybe "" constructParam t - where - constructParam x = getTypeName ctx x `mappend` fromText " param" - -paramOrBondVoid :: Maybe Type -> String -paramOrBondVoid t = if isNothing t then "new global::Bond.Void()" else "param" - --- | Codegen template for generating code containing declarations of --- of services including interfaces, proxies and services files. - -comm_interface_cs :: MappingContext -> String -> [Import] -> [Declaration] -> (String, L.Text) -comm_interface_cs cs _ _ declarations = ("_interfaces.cs", [lt| -#{CS.disableCscWarnings} -#{CS.disableReSharperWarnings} -namespace #{csNamespace} -{ - using System.Collections.Generic; - - #{doubleLineSep 1 comm declarations} -} // #{csNamespace} -|]) - where - csNamespace = sepBy "." toText $ getNamespace cs - - comm s@Service{..} = [lt|#{CS.typeAttributes cs s}public interface I#{declName}#{generics} - { - #{doubleLineSep 2 methodDeclaration serviceMethods} - } - |] - where - generics = angles $ sepBy ", " paramName declParams - - methodDeclaration Function{..} = [lt|#{CS.schemaAttributes 2 methodAttributes}global::System.Threading.Tasks.Task<global::Bond.Comm.IMessage<#{getMessageResultTypeName}>> #{methodName}Async(global::Bond.Comm.IMessage<#{getMessageInputTypeName}> param, global::System.Threading.CancellationToken ct);|] - where - getMessageResultTypeName = getMessageTypeName cs methodResult - getMessageInputTypeName = getMessageTypeName cs methodInput - - methodDeclaration Event{..} = [lt|#{CS.schemaAttributes 2 methodAttributes}void #{methodName}Async(global::Bond.Comm.IMessage<#{getMessageInputTypeName}> param);|] - where - getMessageInputTypeName = getMessageTypeName cs methodInput - - comm _ = mempty - -comm_proxy_cs :: MappingContext -> String -> [Import] -> [Declaration] -> (String, L.Text) -comm_proxy_cs cs _ _ declarations = ("_proxies.cs", [lt| -#{CS.disableCscWarnings} -#{CS.disableReSharperWarnings} -namespace #{csNamespace} -{ - using System.Collections.Generic; - - #{doubleLineSep 1 comm declarations} -} // #{csNamespace} -|]) - where - csNamespace = sepBy "." toText $ getNamespace cs - idl = MappingContext idlTypeMapping [] [] [] - - comm s@Service{..} = [lt|#{CS.typeAttributes cs s}public class #{declName}Proxy<#{proxyGenerics}TConnection> : I#{declName}#{interfaceGenerics}#{connConstraint} - { - private readonly TConnection m_connection; - - public #{declName}Proxy(TConnection connection) - { - m_connection = connection; - } - - #{doubleLineSep 2 proxyMethod serviceMethods} - }|] - where - methodCapability Function {} = "global::Bond.Comm.IRequestResponseConnection" - methodCapability Event {} = "global::Bond.Comm.IEventConnection" - - getCapabilities :: [Method] -> [String] - getCapabilities m = nub $ map methodCapability m - connConstraint = " where TConnection : " ++ sepBy ", " (\p -> p) (getCapabilities serviceMethods) - - interfaceGenerics = angles $ sepBy "," paramName declParams -- of the form "<T1, T2, T3>" - proxyGenerics = sepEndBy ", " paramName declParams -- of the form "T1, T2, T3, " - - proxyMethod Function{..} = [lt|#{CS.schemaAttributes 2 methodAttributes}public global::System.Threading.Tasks.Task<global::Bond.Comm.IMessage<#{getMessageResultTypeName}>> #{methodName}Async(#{getMessageProxyInputParam cs methodInput}) - { - var message = new global::Bond.Comm.Message<#{getMessageInputTypeName}>(#{paramOrBondVoid methodInput}); - return #{methodName}Async(message, global::System.Threading.CancellationToken.None); - } - - public global::System.Threading.Tasks.Task<global::Bond.Comm.IMessage<#{getMessageResultTypeName}>> #{methodName}Async(global::Bond.Comm.IMessage<#{getMessageInputTypeName}> param, global::System.Threading.CancellationToken ct) - { - return m_connection.RequestResponseAsync<#{getMessageInputTypeName}, #{getMessageResultTypeName}>( - "#{getDeclTypeName idl s}", - "#{methodName}", - param, - ct); - }|] - where - getMessageResultTypeName = getMessageTypeName cs methodResult - getMessageInputTypeName = getMessageTypeName cs methodInput - - proxyMethod Event{..} = [lt|#{CS.schemaAttributes 2 methodAttributes}public void #{methodName}Async(#{getMessageProxyInputParam cs methodInput}) - { - var message = new global::Bond.Comm.Message<#{getMessageInputTypeName}>(#{paramOrBondVoid methodInput}); - #{methodName}Async(message); - } - - public void #{methodName}Async(global::Bond.Comm.IMessage<#{getMessageInputTypeName}> param) - { - m_connection.FireEventAsync<#{getMessageInputTypeName}>( - "#{getDeclTypeName idl s}", - "#{methodName}", - param); - }|] - where - getMessageInputTypeName = getMessageTypeName cs methodInput - - comm _ = mempty - -comm_service_cs :: MappingContext -> String -> [Import] -> [Declaration] -> (String, L.Text) -comm_service_cs cs _ _ declarations = ("_services.cs", [lt| -#{CS.disableCscWarnings} -#{CS.disableReSharperWarnings} -namespace #{csNamespace} -{ - using System.Collections.Generic; - - #{doubleLineSep 1 comm declarations} -} // #{csNamespace} -|]) - where - csNamespace = sepBy "." toText $ getNamespace cs - idl = MappingContext idlTypeMapping [] [] [] - - comm s@Service{..} = [lt|#{CS.typeAttributes cs s}public abstract class #{declName}ServiceBase#{generics} : I#{declName}#{generics}, global::Bond.Comm.IService - { - public global::System.Collections.Generic.IEnumerable<global::Bond.Comm.ServiceMethodInfo> Methods - { - get - { - #{newlineSep 4 methodInfo serviceMethods} - } - } - - #{doubleLineSep 2 methodAbstract serviceMethods} - - #{doubleLineSep 2 methodGlue serviceMethods} - } - |] - where - generics = angles $ sepBy ", " paramName declParams - - methodInfo Function{..} = [lt|yield return new global::Bond.Comm.ServiceMethodInfo {MethodName="#{getDeclTypeName idl s}.#{methodName}", Callback = #{methodName}Async_Glue, CallbackType = global::Bond.Comm.ServiceCallbackType.RequestResponse};|] - methodInfo Event{..} = [lt|yield return new global::Bond.Comm.ServiceMethodInfo {MethodName="#{getDeclTypeName idl s}.#{methodName}", Callback = #{methodName}Async_Glue, CallbackType = global::Bond.Comm.ServiceCallbackType.Event};|] - - methodAbstract Function{..} = [lt|#{CS.schemaAttributes 2 methodAttributes}public abstract global::System.Threading.Tasks.Task<global::Bond.Comm.IMessage<#{getMessageResultTypeName}>> #{methodName}Async(global::Bond.Comm.IMessage<#{getMessageInputTypeName}> param, global::System.Threading.CancellationToken ct);|] - where - getMessageResultTypeName = getMessageTypeName cs methodResult - getMessageInputTypeName = getMessageTypeName cs methodInput - - methodAbstract Event{..} = [lt|public abstract void #{methodName}Async(global::Bond.Comm.IMessage<#{getMessageInputTypeName}> param);|] - where - getMessageInputTypeName = getMessageTypeName cs methodInput - - methodGlue Function{..} = [lt|private global::System.Threading.Tasks.Task<global::Bond.Comm.IMessage> #{methodName}Async_Glue(global::Bond.Comm.IMessage param, global::Bond.Comm.ReceiveContext context, global::System.Threading.CancellationToken ct) - { - return global::Bond.Comm.CodegenHelpers.Upcast<global::Bond.Comm.IMessage<#{getMessageResultTypeName}>, - global::Bond.Comm.IMessage>( - #{methodName}Async(param.Convert<#{getMessageInputTypeName}>(), ct)); - }|] - where - getMessageResultTypeName = getMessageTypeName cs methodResult - getMessageInputTypeName = getMessageTypeName cs methodInput - - methodGlue Event{..} = [lt|#{CS.schemaAttributes 2 methodAttributes}private global::System.Threading.Tasks.Task #{methodName}Async_Glue(global::Bond.Comm.IMessage param, global::Bond.Comm.ReceiveContext context, global::System.Threading.CancellationToken ct) - { - #{methodName}Async(param.Convert<#{getMessageInputTypeName}>()); - return global::Bond.Comm.CodegenHelpers.CompletedTask; - }|] - where - getMessageInputTypeName = getMessageTypeName cs methodInput - - comm _ = mempty
src/Language/Bond/Codegen/Cs/Grpc_cs.hs view
@@ -1,26 +1,49 @@ -- Copyright (c) Microsoft. All rights reserved. -- Licensed under the MIT license. See LICENSE file in the project root for full license information. -{-# LANGUAGE QuasiQuotes, OverloadedStrings, RecordWildCards #-} +{-# LANGUAGE OverloadedStrings, QuasiQuotes, RecordWildCards #-} module Language.Bond.Codegen.Cs.Grpc_cs ( grpc_cs) where -import Data.Maybe import Data.Monoid -import Prelude import qualified Data.Text.Lazy as L -import Text.Shakespeare.Text -import Language.Bond.Syntax.Types -import Language.Bond.Util -import Language.Bond.Codegen.Util -import Language.Bond.Codegen.TypeMapping import qualified Language.Bond.Codegen.Cs.Util as CS +import Language.Bond.Codegen.TypeMapping +import Language.Bond.Codegen.Util +import Language.Bond.Syntax.Types hiding (methodTypeToMaybe) +import Language.Bond.Util +import Prelude +import Text.Shakespeare.Text +-- | Represents a parameter in an abstract server method. +-- +-- This data definition would be in the where clause of grpc_cs if data +-- definitions were permitted in where clauses. +data CsServerMethodParam = CsServerMethodParam { name :: L.Text, csType :: L.Text } + +-- | Generates a C# parameter declaration for a server method parameter. +csServerParamDecl :: CsServerMethodParam -> L.Text +csServerParamDecl (CsServerMethodParam {..}) = [lt|#{csType} #{name}|] + +-- | Contains splicable text for a client method's first parameter. Create +-- one of these with the function csClientRequestParam. Some kinds of +-- methods don't need a first param, so some of the record's fields may be +-- empty. If non-empty, the correct comma and space are included so this +-- text can just be spliced in. +-- +-- This data definition would be in the where clause of grpc_cs if data +-- definitions were permitted in where clauses. +data CsClientRequestParam = CsClientRequestParam + { bareParam :: L.Text -- bare param declaration: what the caller passes in, if applicable + , messageParam :: L.Text -- param declaration wrapped in an IMessage + , toMessage :: L.Text -- code to create an IMessage for the request + , forwardMessageParam :: L.Text -- code to forward the IMessage param on to the CallInvoker + } + -- | Codegen template for generating code containing declarations of -- of services including proxies and services files for gRPC integration. - grpc_cs :: MappingContext -> String -> [Import] -> [Declaration] -> (String, L.Text) grpc_cs cs _ _ declarations = ("_grpc.cs", [lt| #{CS.disableCscWarnings} @@ -83,66 +106,132 @@ uniqImplName name = uniqueName (name ++ "_impl") methodNames - getMessageTypeName t = maybe "global::Bond.Void" (getTypeName cs) t + csTypeOf Void = "global::Bond.Void" + csTypeOf (Unary t) = getTypeName cs t + csTypeOf (Streaming t) = getTypeName cs t + csRequestTypeName (Function {..}) = csTypeOf methodInput + csRequestTypeName (Event {..}) = csTypeOf methodInput + + csResponseTypeName (Function {..}) = csTypeOf methodResult + csResponseTypeName Event{} = csTypeOf Void + + messageVoid = [lt|global::Bond.Grpc.IMessage<global::Bond.Void>|] + + messageOf :: Type -> L.Text + messageOf t = [lt|global::Bond.Grpc.IMessage<#{getTypeName cs t}>|] + + methodTypeEnum :: Method -> L.Text + methodTypeEnum (Function {..}) = case (methodResult, methodInput) of + (Streaming _, Streaming _) -> [lt|global::Grpc.Core.MethodType.DuplexStreaming|] + (Streaming _, _) -> [lt|global::Grpc.Core.MethodType.ServerStreaming|] + (_, Streaming _) -> [lt|global::Grpc.Core.MethodType.ClientStreaming|] + _ -> [lt|global::Grpc.Core.MethodType.Unary|] + methodTypeEnum (Event {..}) = case methodInput of + Streaming _ -> error ("Unexpected event '" ++ methodName ++ "' with Streaming parameter") -- the parser should have rejected this + _ -> [lt|global::Grpc.Core.MethodType.Unary|] + generics = angles $ sepBy ", " paramName declParams genericsWhere = sepBy " " addWhere declParams where addWhere a = [lt|where #{paramName a} : class|] - methodDeclaration Function{..} = [lt|static readonly global::Grpc.Core.Method<global::Bond.Grpc.IMessage<#{getMessageTypeName methodInput}>, global::Bond.Grpc.IMessage<#{getMessageTypeName methodResult}>> Method_#{methodName} = new global::Grpc.Core.Method<global::Bond.Grpc.IMessage<#{getMessageTypeName methodInput}>, global::Bond.Grpc.IMessage<#{getMessageTypeName methodResult}>>( - global::Grpc.Core.MethodType.Unary, + methodDeclaration m = [lt|static readonly global::Grpc.Core.Method<global::Bond.Grpc.IMessage<#{csRequestTypeName m}>, global::Bond.Grpc.IMessage<#{csResponseTypeName m}>> Method_#{methodName m} = new global::Grpc.Core.Method<global::Bond.Grpc.IMessage<#{csRequestTypeName m}>, global::Bond.Grpc.IMessage<#{csResponseTypeName m}>>( + #{methodTypeEnum m}, ServiceName, - "#{methodName}", - global::Bond.Grpc.Marshaller<#{getMessageTypeName methodInput}>.Instance, - global::Bond.Grpc.Marshaller<#{getMessageTypeName methodResult}>.Instance);|] + "#{methodName m}", + global::Bond.Grpc.Marshaller<#{csRequestTypeName m}>.Instance, + global::Bond.Grpc.Marshaller<#{csResponseTypeName m}>.Instance);|] - methodDeclaration Event{..} = [lt|static readonly global::Grpc.Core.Method<global::Bond.Grpc.IMessage<#{getMessageTypeName methodInput}>, global::Bond.Grpc.IMessage<#{getMessageTypeName Nothing}>> Method_#{methodName} = new global::Grpc.Core.Method<global::Bond.Grpc.IMessage<#{getMessageTypeName methodInput}>, global::Bond.Grpc.IMessage<#{getMessageTypeName Nothing}>>( - global::Grpc.Core.MethodType.Unary, - ServiceName, - "#{methodName}", - global::Bond.Grpc.Marshaller<#{getMessageTypeName methodInput}>.Instance, - global::Bond.Grpc.Marshaller<#{getMessageTypeName Nothing}>.Instance);|] + serverMethodParams :: MethodType -> MethodType -> [CsServerMethodParam] + serverMethodParams reqType respType = (forRequest reqType) ++ (forResponse respType) ++ context + where + forRequest Void = [(CsServerMethodParam [lt|request|] messageVoid)] + forRequest (Unary t) = [(CsServerMethodParam [lt|request|] [lt|#{messageOf t}|])] + forRequest (Streaming t) = [(CsServerMethodParam [lt|requests|] [lt|Grpc.Core.IAsyncStreamReader<#{messageOf t}>|])] + forResponse Void = [] + forResponse (Unary _) = [] + forResponse (Streaming t) = [(CsServerMethodParam [lt|responses|] [lt|Grpc.Core.IAsyncStreamWriter<#{messageOf t}>|])] + context = [(CsServerMethodParam [lt|context|] [lt|global::Grpc.Core.ServerCallContext|])] - serverBaseMethods Function{..} = [lt|#{CS.schemaAttributes 3 methodAttributes}public abstract global::System.Threading.Tasks.Task<global::Bond.Grpc.IMessage<#{getMessageTypeName methodResult}>> #{methodName}(global::Bond.Grpc.IMessage<#{getMessageTypeName methodInput}> request, global::Grpc.Core.ServerCallContext context);|] + -- | For functions (not events), given the result type, compute the + -- C# abstract method return type. + csServerFunctionReturn :: MethodType -> L.Text + csServerFunctionReturn Void = [lt|global::System.Threading.Tasks.Task<#{messageVoid}>|] + csServerFunctionReturn (Unary t) = [lt|global::System.Threading.Tasks.Task<#{messageOf t}>|] + csServerFunctionReturn (Streaming _) = [lt|global::System.Threading.Tasks.Task|] - serverBaseMethods Event{..} = [lt|#{CS.schemaAttributes 3 methodAttributes}public abstract global::System.Threading.Tasks.Task #{methodName}(global::Bond.Grpc.IMessage<#{getMessageTypeName methodInput}> request, global::Grpc.Core.ServerCallContext context); + serverBaseMethods Function{..} = [lt|#{CS.schemaAttributes 3 methodAttributes}public abstract #{csServerFunctionReturn methodResult} #{methodName}(#{csParams});|] + where params = serverMethodParams methodInput methodResult + csParams = commaSep csServerParamDecl params - internal global::System.Threading.Tasks.Task<global::Bond.Grpc.IMessage<#{getMessageTypeName Nothing}>> #{uniqImplName methodName}(global::Bond.Grpc.IMessage<#{getMessageTypeName methodInput}> request, global::Grpc.Core.ServerCallContext context) { - return global::Bond.Grpc.Internal.NothingCallHandler.Handle(#{methodName}, request, context); + serverBaseMethods Event{..} = [lt|#{CS.schemaAttributes 3 methodAttributes}public abstract global::System.Threading.Tasks.Task #{methodName}(#{csParams}); + + internal global::System.Threading.Tasks.Task<#{messageVoid}> #{uniqImplName methodName}(#{csParams}) { + return global::Bond.Grpc.Internal.NothingCallHandler.Handle(#{handlerArgs}); }|] + where params = serverMethodParams methodInput Void + csParams = commaSep csServerParamDecl params + handlerArgs = commaSep id ((L.pack methodName):(map name params)) - firstParam Nothing = mempty - firstParam t = [lt|#{getMessageTypeName t} request, |] + -- | For functions (not events), given the input and result types, + -- compute the C# client method return type. + csClientFunctionReturn :: MethodType -> MethodType -> L.Text + csClientFunctionReturn (Streaming input) (Streaming result) = [lt|global::Grpc.Core.AsyncDuplexStreamingCall<#{messageOf input}, #{messageOf result}>|] + csClientFunctionReturn (Streaming input) (Unary result) = [lt|global::Grpc.Core.AsyncClientStreamingCall<#{messageOf input}, #{messageOf result}>|] + csClientFunctionReturn _ (Streaming result) = [lt|global::Grpc.Core.AsyncServerStreamingCall<#{messageOf result}>|] + csClientFunctionReturn _ (Unary result) = [lt|global::Grpc.Core.AsyncUnaryCall<#{messageOf result}>|] + csClientFunctionReturn _ Void = [lt|global::Grpc.Core.AsyncUnaryCall<#{messageVoid}>|] - requestOrVoidConstructor Nothing = [lt|global::Bond.Grpc.Message.Void|] - requestOrVoidConstructor _ = [lt|global::Bond.Grpc.Message.From(request)|] + -- | Given the input type, compute the client method parameter. + csClientRequestParam :: MethodType -> CsClientRequestParam + csClientRequestParam Void = CsClientRequestParam + { bareParam = mempty + , messageParam = [lt|#{messageVoid} request, |] + , toMessage = [lt|global::Bond.Grpc.Message.Void, |] + , forwardMessageParam = [lt|, request|] } + csClientRequestParam (Unary t) = CsClientRequestParam + { bareParam = [lt|#{getTypeName cs t} request, |] + , messageParam = [lt|#{messageOf t} request, |] + , toMessage = [lt|global::Bond.Grpc.Message.From(request), |] + , forwardMessageParam = [lt|, request|] } + csClientRequestParam (Streaming _) = CsClientRequestParam + { bareParam = mempty + , messageParam = mempty + , toMessage = mempty + , forwardMessageParam = mempty } - clientMethods Function{..} = [lt|#{CS.schemaAttributes 3 methodAttributes}public virtual global::Grpc.Core.AsyncUnaryCall<global::Bond.Grpc.IMessage<#{getMessageTypeName methodResult}>> #{methodName}Async(#{firstParam methodInput}global::Grpc.Core.Metadata headers = null, global::System.DateTime? deadline = null, global::System.Threading.CancellationToken cancellationToken = default(global::System.Threading.CancellationToken)) + -- | Given the input and result types, compute the call invoker needed. + clientCallInvoker :: MethodType -> MethodType -> L.Text + clientCallInvoker (Streaming _) (Streaming _) = [lt|AsyncDuplexStreamingCall|] + clientCallInvoker (Streaming _) (Unary _) = [lt|AsyncClientStreamingCall|] + clientCallInvoker (Unary _) (Streaming _) = [lt|AsyncServerStreamingCall|] + clientCallInvoker _ _ = [lt|AsyncUnaryCall|] + + clientMethods Function{..} = [lt|#{CS.schemaAttributes 3 methodAttributes}public virtual #{csClientFunctionReturn methodInput methodResult} #{methodName}Async(#{bareParam requestParam}global::Grpc.Core.Metadata headers = null, global::System.DateTime? deadline = null, global::System.Threading.CancellationToken cancellationToken = default(global::System.Threading.CancellationToken)) { - var message = #{requestOrVoidConstructor methodInput}; - return #{methodName}Async(message, new global::Grpc.Core.CallOptions(headers, deadline, cancellationToken)); + return #{methodName}Async(#{toMessage requestParam}new global::Grpc.Core.CallOptions(headers, deadline, cancellationToken)); } - public virtual global::Grpc.Core.AsyncUnaryCall<global::Bond.Grpc.IMessage<#{getMessageTypeName methodResult}>> #{methodName}Async(global::Bond.Grpc.IMessage<#{getMessageTypeName methodInput}> request, global::Grpc.Core.CallOptions options) + #{CS.schemaAttributes 3 methodAttributes}public virtual #{csClientFunctionReturn methodInput methodResult} #{methodName}Async(#{messageParam requestParam}global::Grpc.Core.CallOptions options) { - return CallInvoker.AsyncUnaryCall(Method_#{methodName}, null, options, request); + return CallInvoker.#{clientCallInvoker methodInput methodResult}(Method_#{methodName}, null, options#{forwardMessageParam requestParam}); }|] + where requestParam = csClientRequestParam methodInput - clientMethods Event{..} = [lt|#{CS.schemaAttributes 3 methodAttributes}public virtual void #{methodName}Async(#{firstParam methodInput}global::Grpc.Core.Metadata headers = null, global::System.DateTime? deadline = null, global::System.Threading.CancellationToken cancellationToken = default(global::System.Threading.CancellationToken)) + clientMethods Event{..} = [lt|#{CS.schemaAttributes 3 methodAttributes}public virtual void #{methodName}Async(#{bareParam requestParam}global::Grpc.Core.Metadata headers = null, global::System.DateTime? deadline = null, global::System.Threading.CancellationToken cancellationToken = default(global::System.Threading.CancellationToken)) { - var message = #{requestOrVoidConstructor methodInput}; - #{methodName}Async(message, new global::Grpc.Core.CallOptions(headers, deadline, cancellationToken)); + #{methodName}Async(#{toMessage requestParam}new global::Grpc.Core.CallOptions(headers, deadline, cancellationToken)); } - public virtual void #{methodName}Async(global::Bond.Grpc.IMessage<#{getMessageTypeName methodInput}> request, global::Grpc.Core.CallOptions options) + #{CS.schemaAttributes 3 methodAttributes}public virtual void #{methodName}Async(#{messageParam requestParam}global::Grpc.Core.CallOptions options) { - global::Bond.Grpc.Internal.NothingCallInvoker.NothingCall(CallInvoker, Method_#{methodName}, null, options, request); + global::Bond.Grpc.Internal.NothingCallInvoker.NothingCall(CallInvoker, Method_#{methodName}, null, options#{forwardMessageParam requestParam}); }|] + where requestParam = csClientRequestParam methodInput serviceMethodBuilder Function{..} = [lt|.AddMethod(Method_#{methodName}, serviceImpl.#{methodName})|] - serviceMethodBuilder Event{..} = [lt|.AddMethod(Method_#{methodName}, serviceImpl.#{uniqImplName methodName})|] grpc _ = mempty
src/Language/Bond/Codegen/Cs/Types_cs.hs view
@@ -7,12 +7,12 @@ ( types_cs , FieldMapping(..) , StructMapping(..) + , ConstructorOptions(..) ) where import Data.Monoid -import qualified Data.Foldable as F import Prelude -import Data.Text.Lazy (Text) +import Data.Text.Lazy (Text, pack) import Text.Shakespeare.Text import Language.Bond.Syntax.Types import Language.Bond.Syntax.Util @@ -34,12 +34,19 @@ ReadOnlyProperties -- ^ auto-properties with private setter deriving Eq +-- | Options for how constructors should be generated. +data ConstructorOptions = + DefaultWithProtectedBase | -- ^ The original bond behavior. + ConstructorParameters -- ^ Generate a constructor that takes all the fields as parameters. + deriving Eq + -- | Codegen template for generating definitions of C# types representing the schema. types_cs :: StructMapping -- ^ Specifies how to represent schema structs -> FieldMapping -- ^ Specifies how to represent schema fields + -> ConstructorOptions -- ^ Specifies the constructors that should be generated -> MappingContext -> String -> [Import] -> [Declaration] -> (String, Text) -types_cs structMapping fieldMapping cs _ _ declarations = (fileSuffix, [lt| +types_cs structMapping fieldMapping constructorOptions cs _ _ declarations = (fileSuffix, [lt| #{CS.disableCscWarnings} #{CS.disableReSharperWarnings} namespace #{csNamespace} @@ -71,6 +78,9 @@ propertyAttributes f = case structMapping of Class -> CS.propertyAttributes cs f + baseClass x = [lt| + : #{csType x}|] + -- C# type definition for schema struct typeDefinition s@Struct {..} = [lt|#{typeAttributes s}#{struct}#{declName}#{params}#{maybe interface baseClass structBase}#{constraints} { @@ -86,21 +96,16 @@ -- constraints constraints = CS.paramConstraints declParams - -- base - callBaseCtor = getAny $ optional (foldMapFields metaField) structBase - - baseClass x = [lt| - : #{csType x}|] - - baseCtor = if not callBaseCtor then mempty else [lt| - : base(fullName, name)|] - -- default value csDefault = CS.defaultValue cs - -- constructors - constructors = if noCtor then mempty else [lt| + metaFields = filter (isMetaName . fieldType) structFields + noMetaFields = null metaFields + + -- constructor: DefaultWithProtectedBase option + defaultWithProtectedBaseConstructor = if noCtor then mempty else [lt| + public #{declName}() : this("#{getDeclTypeName idl s}", "#{declName}") {} @@ -111,7 +116,65 @@ }|] where noCtor = not callBaseCtor && (fieldMapping == PublicFields && noMetaFields || null structFields) - noMetaFields = not $ getAny $ F.foldMap metaField structFields + callBaseCtor = getAny $ optional (foldMapFields metaField) structBase + baseCtor = if not callBaseCtor + then mempty + else [lt| + : base(fullName, name)|] + + -- constructor: ConstructorParameters option + constructorWithParameters = if not noMetaFields + then error $ "bond_meta usage in Struct " ++ (show declName) ++ " Field " ++ (show $ fieldName $ head metaFields) ++ " is incompatible with --preview--constructor-parameters" + else if (null baseFieldList) + then [lt| + + public #{declName}( + #{commaLineSep 3 paramDecl fieldNameList}) + { + #{newlineSep 3 paramBasedInitializer fieldNameList} + } + + public #{declName}() + { + #{newlineSep 3 initializer structFields} + }|] + else [lt| + + public #{declName}( + // Base class parameters + #{commaLineSep 3 paramDecl (zip baseFieldList uniqueBaseFieldNames)}#{thisParamBlock} + ) : base( + #{commaLineSep 4 pack uniqueBaseFieldNames}) + { + #{newlineSep 3 paramBasedInitializer (zip structFields uniqueThisFieldNames)} + } + + public #{declName}() + { + #{newlineSep 3 initializer structFields} + }|] + + thisParamBlock = if null structFields + then mempty + else [lt|, + + // This class parameters + #{commaLineSep 3 paramDecl (zip structFields uniqueThisFieldNames)}|] + + baseFieldList = concat $ baseFields s + + uniqueBaseFieldNames = uniqueNames (map fieldName baseFieldList) [] + uniqueThisFieldNames = uniqueNames (map fieldName structFields) uniqueBaseFieldNames + + paramDecl (f, n) = [lt|#{csType $ fieldType f} #{n}|] + + paramBasedInitializer (f, n) = [lt|this.#{fieldName f} = #{n};|] + + fieldNameList = map (\f -> (f, fieldName f)) structFields + + constructors = case constructorOptions of + DefaultWithProtectedBase -> defaultWithProtectedBaseConstructor + ConstructorParameters -> constructorWithParameters -- property or field property f@Field {..} =
src/Language/Bond/Codegen/Cs/Util.hs view
@@ -86,7 +86,7 @@ |] idl :: MappingContext -idl = MappingContext idlTypeMapping [] [] [] +idl = MappingContext idlTypeMapping [] [] [] optionalTypeAttributes :: MappingContext -> Declaration -> Text optionalTypeAttributes cs decl = @@ -100,7 +100,7 @@ -- Attributes defined by the user in the schema schemaAttributes :: Int64 -> [Attribute] -> Text -schemaAttributes indent = newlineSepEnd indent schemaAttribute +schemaAttributes indent_ = newlineSepEnd indent_ schemaAttribute where schemaAttribute Attribute {..} = [lt|[global::Bond.Attribute("#{getQualifiedName idl attrName}", "#{attrValue}")]|]
src/Language/Bond/Codegen/CustomMapping.hs view
@@ -11,11 +11,13 @@ , parseNamespaceMapping ) where -import Data.Char import Control.Applicative -import Prelude -import Text.Parsec hiding (many, optional, (<|>)) +import Data.Void (Void) import Language.Bond.Syntax.Types +import Prelude +import Text.Megaparsec hiding (many, optional, (<|>)) +import Text.Megaparsec.Char +import qualified Text.Megaparsec.Char.Lexer as L -- | Specification of a fragment of type alias mappings. data Fragment = @@ -34,46 +36,65 @@ , toNamespace :: QualifiedName -- ^ namespace in the generated code } -type Parser a = Parsec SourceName () a +type Parser = Parsec Void String -whitespace :: Parser String -whitespace = many (char ' ') <?> "whitespace" identifier :: Parser String -identifier = many1 (alphaNum <|> char '_') <?> "identifier" +identifier = some (alphaNumChar <|> char '_') <?> "identifier" + qualifiedName :: Parser [String] qualifiedName = sepBy1 identifier (char '.') <?> "qualified name" + +sc :: Parser () +sc = L.space space1 empty empty + symbol :: String -> Parser String -symbol s = whitespace *> string s <* whitespace +symbol = L.symbol sc + equal :: Parser String equal = symbol "=" + +-- consume whitespace after every lexeme +lexeme :: Parser a -> Parser a +lexeme = L.lexeme sc + +decimal :: Parser Integer +decimal = lexeme L.decimal + +hexadecimal :: Parser Integer +hexadecimal = lexeme . try $ char '0' >> char' 'x' >> L.hexadecimal + +octal :: Parser Integer +octal = lexeme . try $ char '0' >> char' 'o' >> L.octal + +natural :: Parser Integer +natural = hexadecimal <|> octal <|> decimal + integer :: Parser Integer -integer = decimal <$> many1 digit <?> "decimal number" - where - decimal = foldl (\x d -> 10 * x + toInteger (digitToInt d)) 0 +integer = L.signed sc natural --- | Parse a type alias mapping specification used in command-line arguments of +-- | Parse a type alias mapping specification used in command-line arguments of -- <https://microsoft.github.io/bond/manual/compiler.html#command-line-options gbc>. -- -- ==== __Examples__ -- -- > > parseAliasMapping "Example.OrderedSet=SortedSet<{0}>" -- > Right (AliasMapping {aliasName = ["Example","OrderedSet"], aliasTemplate = [Fragment "SortedSet<",Placeholder 0,Fragment ">"]}) -parseAliasMapping :: String -> Either ParseError AliasMapping -parseAliasMapping s = parse aliasMapping s s +parseAliasMapping :: String -> Either (ParseError Char Void) AliasMapping +parseAliasMapping s = parse aliasMapping "" s where - aliasMapping = AliasMapping <$> qualifiedName <* equal <*> many1 (placeholder <|> fragment) <* eof + aliasMapping = AliasMapping <$> qualifiedName <* equal <*> some (placeholder <|> fragment) <* eof placeholder = Placeholder <$> fromIntegral <$> between (char '{') (char '}') integer - fragment = Fragment <$> many1 (noneOf "{") + fragment = Fragment <$> some (notChar '{') --- | Parse a namespace mapping specification used in command-line arguments of +-- | Parse a namespace mapping specification used in command-line arguments of -- <https://microsoft.github.io/bond/manual/compiler.html#command-line-options gbc>. -- -- ==== __Examples__ -- -- > > parseNamespaceMapping "bond=Microsoft.Bond" -- > Right (NamespaceMapping {fromNamespace = ["bond"], toNamespace = ["Microsoft","Bond"]}) -parseNamespaceMapping :: String -> Either ParseError NamespaceMapping -parseNamespaceMapping s = parse namespaceMapping s s +parseNamespaceMapping :: String -> Either (ParseError Char Void) NamespaceMapping +parseNamespaceMapping s = parse namespaceMapping "" s where namespaceMapping = NamespaceMapping <$> qualifiedName <* equal <*> qualifiedName
+ src/Language/Bond/Codegen/Java/Class_java.hs view
@@ -0,0 +1,638 @@+-- Copyright (c) Microsoft. All rights reserved. +-- Licensed under the MIT license. See LICENSE file in the project root +-- for full license information. + +{-# LANGUAGE QuasiQuotes, OverloadedStrings, RecordWildCards #-} + +module Language.Bond.Codegen.Java.Class_java + ( class_java + , JavaFieldMapping(..) + ) where + +import Prelude +import Data.Text.Lazy (Text) +import Text.Shakespeare.Text +import Language.Bond.Syntax.Types +import Language.Bond.Syntax.Util +import Language.Bond.Util +import Language.Bond.Codegen.TypeMapping +import Language.Bond.Codegen.Util +import Language.Bond.Codegen.Java.Util + + +-- field -> public field +data JavaFieldMapping = JavaPublicFields deriving Eq + + +-- given the type of the field, returns the name of the struct field descriptor type (a protected nested class within StructBondType) +structFieldDescriptorTypeName :: MappingContext -> Type -> Text +structFieldDescriptorTypeName java = typeName + where + typeName (BT_Maybe BT_Int8) = [lt|org.bondlib.StructBondType.SomethingInt8StructField|] + typeName BT_Int8 = [lt|org.bondlib.StructBondType.Int8StructField|] + typeName (BT_Maybe BT_Int16) = [lt|org.bondlib.StructBondType.SomethingInt16StructField|] + typeName BT_Int16 = [lt|org.bondlib.StructBondType.Int16StructField|] + typeName (BT_Maybe BT_Int32) = [lt|org.bondlib.StructBondType.SomethingInt32StructField|] + typeName BT_Int32 = [lt|org.bondlib.StructBondType.Int32StructField|] + typeName (BT_Maybe BT_Int64) = [lt|org.bondlib.StructBondType.SomethingInt64StructField|] + typeName BT_Int64 = [lt|org.bondlib.StructBondType.Int64StructField|] + typeName (BT_Maybe BT_UInt8) = [lt|org.bondlib.StructBondType.SomethingUInt8StructField|] + typeName BT_UInt8 = [lt|org.bondlib.StructBondType.UInt8StructField|] + typeName (BT_Maybe BT_UInt16) = [lt|org.bondlib.StructBondType.SomethingUInt16StructField|] + typeName BT_UInt16 = [lt|org.bondlib.StructBondType.UInt16StructField|] + typeName (BT_Maybe BT_UInt32) = [lt|org.bondlib.StructBondType.SomethingUInt32StructField|] + typeName BT_UInt32 = [lt|org.bondlib.StructBondType.UInt32StructField|] + typeName (BT_Maybe BT_UInt64) = [lt|org.bondlib.StructBondType.SomethingUInt64StructField|] + typeName BT_UInt64 = [lt|org.bondlib.StructBondType.UInt64StructField|] + typeName (BT_Maybe BT_Float) = [lt|org.bondlib.StructBondType.SomethingFloatStructField|] + typeName BT_Float = [lt|org.bondlib.StructBondType.FloatStructField|] + typeName (BT_Maybe BT_Double) = [lt|org.bondlib.StructBondType.SomethingDoubleStructField|] + typeName BT_Double = [lt|org.bondlib.StructBondType.DoubleStructField|] + typeName (BT_Maybe BT_Bool) = [lt|org.bondlib.StructBondType.SomethingBoolStructField|] + typeName BT_Bool = [lt|org.bondlib.StructBondType.BoolStructField|] + typeName (BT_Maybe BT_String) = [lt|org.bondlib.StructBondType.SomethingStringStructField|] + typeName BT_String = [lt|org.bondlib.StructBondType.StringStructField|] + typeName (BT_Maybe BT_WString) = [lt|org.bondlib.StructBondType.SomethingWStringStructField|] + typeName BT_WString = [lt|org.bondlib.StructBondType.WStringStructField|] + typeName (BT_Maybe BT_MetaName) = [lt|org.bondlib.StructBondType.SomethingStringStructField|] + typeName BT_MetaName = [lt|org.bondlib.StructBondType.StringStructField|] + typeName (BT_Maybe BT_MetaFullName) = [lt|org.bondlib.StructBondType.SomethingStringStructField|] + typeName BT_MetaFullName = [lt|org.bondlib.StructBondType.StringStructField|] + typeName (BT_Maybe (BT_UserDefined e@Enum {} _)) = [lt|org.bondlib.StructBondType.SomethingEnumStructField<#{qualifiedDeclaredTypeName java e}>|] + typeName (BT_UserDefined e@Enum {} _) = [lt|org.bondlib.StructBondType.EnumStructField<#{qualifiedDeclaredTypeName java e}>|] + typeName (BT_Maybe (BT_UserDefined a@Alias {} args)) = structFieldDescriptorTypeName java (BT_Maybe (resolveAlias a args)) + typeName (BT_UserDefined a@Alias {} args) = structFieldDescriptorTypeName java (resolveAlias a args) + typeName (BT_Maybe t) = [lt|org.bondlib.StructBondType.SomethingObjectStructField<#{getElementTypeName java t}>|] + typeName t = [lt|org.bondlib.StructBondType.ObjectStructField<#{getElementTypeName java t}>|] + + +-- given the type of the field, value indicating whether a struct field descriptor type is generic and hence needs an explicit type parameter +isGenericStructFieldDescriptor :: Type -> Bool +isGenericStructFieldDescriptor (BT_Maybe t) = not (isPrimitiveNonEnumBondType t) +isGenericStructFieldDescriptor t = not (isPrimitiveNonEnumBondType t) + + +-- given a type parameter, returns the name of a local variable containing the type descriptor +typeParamVarName :: TypeParam -> Text +typeParamVarName TypeParam {..} = [lt|#{paramName}|] + + +-- given a type parameter, returns the declaration of a local variable containing the type descriptor +typeParamVarDecl :: TypeParam -> Text +typeParamVarDecl t@TypeParam {..} = [lt|org.bondlib.BondType<#{paramName}> #{typeParamVarName t}|] + + +-- given a list of type parameters, returns it as comma-separated text +typeParamNameList :: [TypeParam] -> Text +typeParamNameList declParams = [lt|#{sepBy ", " paramName declParams}|] + + +-- given a list of type parameter, returns a comma-separated list of names of local variables containing the type descriptor +typeParamVarNameList :: [TypeParam] -> Text +typeParamVarNameList declParams = [lt|#{sepBy ", " typeParamVarName declParams}|] + + +-- given a list of type parameter, returns a comma-separated list of declarations of local variables containing the type descriptor +typeParamVarDeclList :: [TypeParam] -> Text +typeParamVarDeclList declParams = [lt|#{sepBy ", " typeParamVarDecl declParams}|] + + +-- given a list of type parameters, returns it as comma-separated text with angles (unless the list is empty) +typeParamAnglesNameList :: [TypeParam] -> Text +typeParamAnglesNameList declParams = [lt|#{angles $ typeParamNameList declParams}|] + + +-- given a class name and a list of type parameters, returns the full type name with type parameters (if any) +typeNameWithParams :: String -> [TypeParam] -> Text +typeNameWithParams declName declParams = [lt|#{declName}#{typeParamAnglesNameList declParams}|] + + +-- given a class name and a list of type parameters, returns the full type descriptor name with type parameters (if any) +typeDescriptorNameWithParams :: String -> [TypeParam] -> Text +typeDescriptorNameWithParams declName declParams = [lt|org.bondlib.StructBondType<#{typeNameWithParams declName declParams}>|] + + +-- given a class name, returns the full type descriptor name (using non-generic notation for the struct type) +typeDescriptorName :: String -> Text +typeDescriptorName declName = [lt|org.bondlib.StructBondType<#{declName}>|] + + +-- given a variable name, returns call to ArgumentHelper.ensureNotNull method that checks the variable for null +ensureNotNullArgument :: Text -> Text +ensureNotNullArgument argName = [lt|org.bondlib.ArgumentHelper.ensureNotNull(#{argName}, "#{argName}")|] + + +-- given a field type and optional default value, returns an expression for the parameter containing the default value, +-- along with the leading comma; this value is used in initialization of struct field descriptors where +-- the constructors are overloaded to take explicit default value or take none (i.e. use the implicit default) +fieldDefaultValueInitParamExpr :: MappingContext -> Type -> Maybe Default -> Text +fieldDefaultValueInitParamExpr _ _ (Just (DefaultBool val)) = if val + then [lt|, true|] + else [lt|, false|] +fieldDefaultValueInitParamExpr _ BT_Int8 (Just (DefaultInteger val)) = [lt|, (byte)#{val}|] +fieldDefaultValueInitParamExpr _ BT_Int16 (Just (DefaultInteger val)) = [lt|, (short)#{val}|] +fieldDefaultValueInitParamExpr _ BT_Int32 (Just (DefaultInteger val)) = [lt|, #{val}|] +fieldDefaultValueInitParamExpr _ BT_Int64 (Just (DefaultInteger val)) = [lt|, #{val}L|] +fieldDefaultValueInitParamExpr _ BT_UInt8 (Just (DefaultInteger val)) = [lt|, (byte)#{twosComplement 8 val}|] +fieldDefaultValueInitParamExpr _ BT_UInt16 (Just (DefaultInteger val)) = [lt|, (short)#{twosComplement 16 val}|] +fieldDefaultValueInitParamExpr _ BT_UInt32 (Just (DefaultInteger val)) = [lt|, #{twosComplement 32 val}|] +fieldDefaultValueInitParamExpr _ BT_UInt64 (Just (DefaultInteger val)) = [lt|, #{twosComplement 64 val}L|] +fieldDefaultValueInitParamExpr _ BT_Float (Just (DefaultFloat val)) = [lt|, #{val}F|] +fieldDefaultValueInitParamExpr _ BT_Float (Just (DefaultInteger val)) = [lt|, #{val}F|] +fieldDefaultValueInitParamExpr _ BT_Double (Just (DefaultFloat val)) = [lt|, #{val}D|] +fieldDefaultValueInitParamExpr _ BT_Double (Just (DefaultInteger val)) = [lt|, #{val}D|] +fieldDefaultValueInitParamExpr _ BT_String (Just (DefaultString val)) = [lt|, "#{val}"|] +fieldDefaultValueInitParamExpr _ BT_WString (Just (DefaultString val)) = [lt|, "#{val}"|] +fieldDefaultValueInitParamExpr java (BT_UserDefined e@Enum {..} _) (Just (DefaultEnum val)) = [lt|, #{qualifiedDeclaredTypeName java e}.#{val}|] +fieldDefaultValueInitParamExpr _ _ _ = mempty + + +-- given a struct name and type parameters, and type, returns a type descriptor expression for the field, used in initialization of struct field descriptors +structFieldDescriptorInitStructExpr :: MappingContext -> Type -> String -> [Type] -> Text +structFieldDescriptorInitStructExpr java fieldType typeName params = [lt|#{typeCastExpr} getStructType(#{typeName}.class#{paramExprList params})|] + where + typeCastExpr = [lt|(org.bondlib.StructBondType<#{(getTypeName java) fieldType}>)|] + paramExprList :: [Type] -> Text + paramExprList [] = mempty + paramExprList (x:xs) = [lt|, #{structFieldDescriptorInitTypeExpr java x}#{paramExprList xs}|] + + +-- given field type, returns a type descriptor expression for the field, used in initialization of struct field descriptors +structFieldDescriptorInitTypeExpr :: MappingContext -> Type -> Text +structFieldDescriptorInitTypeExpr java (BT_Maybe t) = structFieldDescriptorInitTypeExpr java t +structFieldDescriptorInitTypeExpr _ BT_Int8 = [lt|org.bondlib.BondTypes.INT8|] +structFieldDescriptorInitTypeExpr _ BT_Int16 = [lt|org.bondlib.BondTypes.INT16|] +structFieldDescriptorInitTypeExpr _ BT_Int32 = [lt|org.bondlib.BondTypes.INT32|] +structFieldDescriptorInitTypeExpr _ BT_Int64 = [lt|org.bondlib.BondTypes.INT64|] +structFieldDescriptorInitTypeExpr _ BT_UInt8 = [lt|org.bondlib.BondTypes.UINT8|] +structFieldDescriptorInitTypeExpr _ BT_UInt16 = [lt|org.bondlib.BondTypes.UINT16|] +structFieldDescriptorInitTypeExpr _ BT_UInt32 = [lt|org.bondlib.BondTypes.UINT32|] +structFieldDescriptorInitTypeExpr _ BT_UInt64 = [lt|org.bondlib.BondTypes.UINT64|] +structFieldDescriptorInitTypeExpr _ BT_Float = [lt|org.bondlib.BondTypes.FLOAT|] +structFieldDescriptorInitTypeExpr _ BT_Double = [lt|org.bondlib.BondTypes.DOUBLE|] +structFieldDescriptorInitTypeExpr _ BT_Bool = [lt|org.bondlib.BondTypes.BOOL|] +structFieldDescriptorInitTypeExpr _ BT_String = [lt|org.bondlib.BondTypes.STRING|] +structFieldDescriptorInitTypeExpr _ BT_WString = [lt|org.bondlib.BondTypes.WSTRING|] +structFieldDescriptorInitTypeExpr _ BT_Blob = [lt|org.bondlib.BondTypes.BLOB|] +structFieldDescriptorInitTypeExpr java (BT_Bonded t) = [lt|bondedOf(#{structFieldDescriptorInitTypeExpr java t})|] +structFieldDescriptorInitTypeExpr java (BT_Nullable t) = [lt|nullableOf(#{structFieldDescriptorInitTypeExpr java t})|] +structFieldDescriptorInitTypeExpr java (BT_Vector t) = [lt|vectorOf(#{structFieldDescriptorInitTypeExpr java t})|] +structFieldDescriptorInitTypeExpr java (BT_List t) = [lt|listOf(#{structFieldDescriptorInitTypeExpr java t})|] +structFieldDescriptorInitTypeExpr java (BT_Set t) = [lt|setOf(#{structFieldDescriptorInitTypeExpr java t})|] +structFieldDescriptorInitTypeExpr java (BT_Map k v) = [lt|mapOf(#{structFieldDescriptorInitTypeExpr java k}, #{structFieldDescriptorInitTypeExpr java v})|] +structFieldDescriptorInitTypeExpr _ (BT_TypeParam param) = [lt|#{paramName param}|] +structFieldDescriptorInitTypeExpr java (BT_UserDefined e@Enum {} _) = [lt|#{qualifiedDeclaredTypeName java e}.BOND_TYPE|] +structFieldDescriptorInitTypeExpr java t@(BT_UserDefined s@Struct {} params) = [lt|#{structFieldDescriptorInitStructExpr java t (qualifiedDeclaredTypeName java s) params}|] +structFieldDescriptorInitTypeExpr java t@(BT_UserDefined s@Forward {} params) = [lt|#{structFieldDescriptorInitStructExpr java t (qualifiedDeclaredTypeName java s) params}|] +structFieldDescriptorInitTypeExpr java (BT_UserDefined a@Alias {} params) = structFieldDescriptorInitTypeExpr java (resolveAlias a params) +structFieldDescriptorInitTypeExpr _ t = error $ "invalid declaration type for structFieldDescriptorInitTypeExpr: " ++ show t + + +-- given struct base type, returns a type descriptor expression +structBaseDescriptorInitStructExpr :: MappingContext -> Maybe Type -> Text +structBaseDescriptorInitStructExpr java t = maybe [lt|null|] (structFieldDescriptorInitTypeExpr java) t + + +-- given struct class name and generic type parameters, builds text for GenericBondTypeBuilder abstract class +-- that defines the public API to specialize a generic struct to specific generic type arguments +-- (this class is generated only when the enclosing Bond struct class is generic) +makeStructMember_GenericBondTypeBuilder :: String -> [TypeParam] -> Text +makeStructMember_GenericBondTypeBuilder declName declParams = [lt| + public static abstract class GenericBondTypeBuilder { + + private GenericBondTypeBuilder() { + } + + public abstract #{typeParamAnglesNameList declParams} #{typeDescriptorNameWithParams declName declParams} makeGenericType(#{typeParamVarDeclList declParams}); + } +|] + + +-- given struct class name and generic type parameters, builds text for implementation +-- of the StructBondTypeBuilderImpl.makeGenericType method +-- (this method is generated only when the enclosing Bond struct class is generic) +makeStructBuilderMember_makeGenericType :: String -> [TypeParam] -> Text +makeStructBuilderMember_makeGenericType declName declParams = [lt| + private #{typeParamAnglesNameList declParams} #{typeDescriptorNameWithParams declName declParams} makeGenericType(#{typeParamVarDeclList declParams}) { + #{newlineSepEnd 4 checkArg declParams}return #{castExpr} this.getInitializedFromCache(#{typeParamVarNameList declParams}); + } +|] + where + checkArg t@TypeParam {..} = [lt|#{ensureNotNullArgument (typeParamVarName t)};|] + castExpr = [lt|(StructBondTypeImpl)|] + + +-- given struct class name and generic type parameters, builds text for implementation of +-- the StructBondTypeBuilderImpl class which is responsible for building the type descriptor +makeStructBondTypeMember_StructBondTypeBuilderImpl :: String -> [TypeParam] -> Text +makeStructBondTypeMember_StructBondTypeBuilderImpl declName declParams = [lt| + static final class StructBondTypeBuilderImpl extends org.bondlib.StructBondType.StructBondTypeBuilder<#{declName}> { + #{ifThenElse (null declParams) mempty (makeStructBuilderMember_makeGenericType declName declParams)} + @Override + public final int getGenericTypeParameterCount() { + return #{length declParams}; + } + + @Override + protected final #{typeDescriptorName declName} buildNewInstance(org.bondlib.BondType[] genericTypeArguments) { + return new StructBondTypeImpl(#{ifThenElse (null declParams) nullText "new org.bondlib.GenericTypeSpecialization(genericTypeArguments)"}); + } + + static void register() { + registerStructType(#{declName}.class, new StructBondTypeBuilderImpl()); + } + }|] + where + nullText = "null" :: Text + + +-- given generic type parameters, struct fields, and base type, builds text for implementation of +-- the StructBondTypeImpl.initialize method +makeStructBondTypeMember_initialize :: MappingContext -> [TypeParam] -> [Field] -> Maybe Type -> Text +makeStructBondTypeMember_initialize java declParams structFields structBase = [lt| + @Override + protected final void initialize() {#{typeArgVarDeclList}#{fieldDescriptorInitList} + super.initializeBaseAndFields(#{baseTypeDescriptorParam}#{fieldTypeDescriptorParamsSeparator}#{fieldTypeDescriptorParams}); + }|] + where + typeArgVarDeclList = newlineBeginSep 3 typeArgVarDecl indexedDeclParams + typeArgVarDecl (index, typeParam) = [lt|#{typeParamVarDecl typeParam} = this.getGenericSpecialization().getGenericTypeArgument(#{index});|] + indexedDeclParams = zip [0 :: Int ..] declParams + + fieldDescriptorInitList = newlineBeginSep 3 fieldDescriptorInit structFields + fieldDescriptorInit Field {..} = [lt|this.#{fieldName} = new #{structFieldDescriptorTypeName java fieldType}(#{constructorParams});|] + where + constructorParams = [lt|this#{fieldTypeParam}, #{fieldOrdinal}, "#{fieldName}", #{modifierConstantName fieldModifier}#{fieldDefaultValueParam}|] + fieldTypeParam = if isGenericStructFieldDescriptor fieldType + then [lt|, #{structFieldDescriptorInitTypeExpr java fieldType}|] + else mempty + fieldDefaultValueParam = fieldDefaultValueInitParamExpr java fieldType fieldDefault + + baseTypeDescriptorParam = structBaseDescriptorInitStructExpr java structBase + fieldTypeDescriptorParamsSeparator = ifThenElse (null structFields) mempty [lt|, |] + fieldTypeDescriptorParams = sepBy ", " structFieldReference structFields + structFieldReference Field {..} = [lt|this.#{fieldName}|] + + +-- given struct class name, generic type parameters, and struct fields, builds text for implementation of +-- the StructBondTypeImpl.serializeStructFields method +makeStructBondTypeMember_serializeStructFields :: String -> [TypeParam] -> [Field] -> Text +makeStructBondTypeMember_serializeStructFields declName declParams structFields = [lt| + @Override + protected final void serializeStructFields(#{methodParamDecl}) throws java.io.IOException {#{newlineBeginSep 3 serializeField structFields} + }|] + where + methodParamDecl = [lt|org.bondlib.BondType.SerializationContext context, #{typeNameWithParams declName declParams} value|] + serializeField Field {..} = [lt|this.#{fieldName}.serialize(context, value.#{fieldName});|] + + +-- given struct class name, generic type parameters, and struct fields, builds text for implementation of +-- the StructBondTypeImpl.deserializeStructFields method for TaggedProtocolReaders +makeStructBondTypeMember_deserializeStructFields_tagged :: String -> [TypeParam] -> [Field] -> Text +makeStructBondTypeMember_deserializeStructFields_tagged declName declParams structFields = [lt| + @Override + protected final void deserializeStructFields(#{methodParamDecl}) throws java.io.IOException {#{newlineBeginSep 3 declareLocalVariable structFields} + while (this.readField(context)) { + switch (context.readFieldResult.id) {#{newlineBeginSep 5 deserializeField structFields} + default: + context.reader.skip(context.readFieldResult.type); + break; + } + }#{newlineBeginSep 3 verifyField structFields} + }|] + where + methodParamDecl = [lt|org.bondlib.BondType.TaggedDeserializationContext context, #{typeNameWithParams declName declParams} value|] + declareLocalVariable Field {..} = [lt|boolean __has_#{fieldName} = false;|] + deserializeField Field {..} = [lt|#{switchCasePart}#{newLine 6}#{deserializePart}#{newLine 6}#{setBooleanPart}#{newLine 6}break;|] + where + switchCasePart = [lt|case #{fieldOrdinal}:|] + deserializePart = [lt|value.#{fieldName} = this.#{fieldName}.deserialize(context, __has_#{fieldName});|] + setBooleanPart = [lt|__has_#{fieldName} = true;|] + + verifyField Field {..} = [lt|this.#{fieldName}.verifyDeserialized(__has_#{fieldName});|] + + +-- given struct class name, generic type parameters, and struct fields, builds text for implementation of +-- the StructBondTypeImpl.deserializeStructFields method for UntaggedProtocolReaders +makeStructBondTypeMember_deserializeStructFields_untagged :: String -> [TypeParam] -> [Field] -> Text +makeStructBondTypeMember_deserializeStructFields_untagged declName declParams structFields = [lt| + @Override + protected final void deserializeStructFields(#{methodParamDecl}) throws java.io.IOException {#{newlineBeginSep 3 declareLocalVariable structFields} + for (final org.bondlib.FieldDef field : structDef.fields) { + switch (field.id) {#{newlineBeginSep 5 deserializeField structFields} + default: + context.reader.skip(context.schema, field.type); + break; + } + }#{newlineBeginSep 3 verifyField structFields} + }|] + where + methodParamDecl = [lt|org.bondlib.BondType.UntaggedDeserializationContext context, org.bondlib.StructDef structDef, #{typeNameWithParams declName declParams} value|] + declareLocalVariable Field {..} = [lt|boolean __has_#{fieldName} = false;|] + deserializeField Field {..} = [lt|#{switchCasePart}#{newLine 6}#{deserializePart}#{newLine 6}#{setBooleanPart}#{newLine 6}break;|] + where + switchCasePart = [lt|case #{fieldOrdinal}:|] + deserializePart = [lt|value.#{fieldName} = this.#{fieldName}.deserialize(context, field.type);|] + setBooleanPart = [lt|__has_#{fieldName} = true;|] + + verifyField Field {..} = [lt|this.#{fieldName}.verifyDeserialized(__has_#{fieldName});|] + + +-- given class name, generic type parameters, and struct fields, builds text for implementation of +-- the StructBondTypeImpl.initializeStructFields method +makeStructBondTypeMember_initializeStructFields :: String -> [TypeParam] -> [Field] -> Text +makeStructBondTypeMember_initializeStructFields declName declParams structFields = [lt| + @Override + protected final void initializeStructFields(#{methodParamDecl}) {#{newlineBeginSep 3 initializeField structFields} + }|] + where + methodParamDecl = [lt|#{typeNameWithParams declName declParams} value|] + initializeField Field {..} = [lt|value.#{fieldName} = this.#{fieldName}.initialize();|] + + +-- given class name, generic type parameters, and struct fields, builds text for implementation of +-- the StructBondTypeImpl.copyStructFields method +makeStructBondTypeMember_cloneStructFields :: String -> [TypeParam] -> [Field] -> Text +makeStructBondTypeMember_cloneStructFields declName declParams structFields = [lt| + @Override + protected final void cloneStructFields(#{methodParamDecl}) {#{newlineBeginSep 3 cloneField structFields} + }|] + where + methodParamDecl = [lt|#{typeNameWithParams declName declParams} fromValue, #{typeNameWithParams declName declParams} toValue|] + cloneField Field {..} = [lt|toValue.#{fieldName} = this.#{fieldName}.clone(fromValue.#{fieldName});|] + + +-- builds text for anonymous implementation of the GenericBondTypeBuilder abstract class and assignment to the BOND_TYPE variable +bondTypeStaticVariableDeclAsGenericBondTypeBuilder :: String -> [TypeParam] -> Text +bondTypeStaticVariableDeclAsGenericBondTypeBuilder declName declParams = [lt|public static final GenericBondTypeBuilder BOND_TYPE = new GenericBondTypeBuilder() { + + final StructBondTypeImpl.StructBondTypeBuilderImpl builder = new StructBondTypeImpl.StructBondTypeBuilderImpl(); + + @Override + public final <#{paramList}> org.bondlib.StructBondType<#{declName}<#{paramList}>> makeGenericType(#{sepBy ", " methodArg declParams}) { + return this.builder.makeGenericType(#{paramList}); + } + };|] + where + paramList = sepBy ", " paramName declParams + methodArg TypeParam {..} = [lt|org.bondlib.BondType<#{paramName}> #{paramName}|] + + +-- builds text for public constructor of non-generic Bond struct class +publicConstructorDeclForNonGenericStruct :: MappingContext -> String -> Maybe Type -> Text +publicConstructorDeclForNonGenericStruct java declName maybeBase = [lt| + public #{declName}() { + super(#{superConstructorArgs maybeBase}); + ((StructBondTypeImpl)BOND_TYPE).initializeStructFields(this); + }; +|] + where + superConstructorArgs Nothing = mempty + superConstructorArgs (Just t) = if isGenericBondStructType t + then [lt|(org.bondlib.StructBondType<#{getTypeName java t}>)BOND_TYPE.getBaseStructType()|] + else mempty + + +-- builds text for public constructor of generic Bond struct class +publicConstructorDeclForGenericStruct :: MappingContext -> String -> [TypeParam] -> Maybe Type -> Text +publicConstructorDeclForGenericStruct java declName declParams maybeBase = [lt| +public #{declName}(org.bondlib.StructBondType<#{declName}<#{paramList}>> genericType) { + super(#{superConstructorArgs maybeBase}); + this.__genericType = (StructBondTypeImpl<#{paramList}>)genericType; + this.__genericType.initializeStructFields(this); + }; +|] + where + paramList = sepBy ", " paramName declParams + superConstructorArgs Nothing = mempty + superConstructorArgs (Just t) = if isGenericBondStructType t + then [lt|(org.bondlib.StructBondType<#{getTypeName java t}>)org.bondlib.ArgumentHelper.ensureNotNull(genericType, "genericType").getBaseStructType()|] + else mempty + + +-- builds text for Object.equals(Object) override +object_equals :: String -> [Field] -> Maybe Type -> Text +object_equals declName fields structBase = [lt|@Override + public boolean equals(Object o) { + if (!(o instanceof #{declName})) return false; + #{compareBase structBase} + final #{declName} other = (#{declName}) o; + #{newlineSep 2 compareField fields} + return true; + } +|] + where + compareBase (Just _) = [lt|if (!(super.equals(o))) return false;|] + compareBase Nothing = mempty + compareField Field {..} = [lt|if (!(#{equalsMember fieldType fieldName})) return false;|] + equalsMember BT_Float f = [lt|org.bondlib.FloatingPointHelper.floatEquals(this.#{f}, other.#{f})|] + equalsMember BT_Double f = [lt|org.bondlib.FloatingPointHelper.doubleEquals(this.#{f}, other.#{f})|] + equalsMember BT_Bool f = [lt|this.#{f} == other.#{f}|] + equalsMember BT_Int8 f = [lt|this.#{f} == other.#{f}|] + equalsMember BT_Int16 f = [lt|this.#{f} == other.#{f}|] + equalsMember BT_Int32 f = [lt|this.#{f} == other.#{f}|] + equalsMember BT_Int64 f = [lt|this.#{f} == other.#{f}|] + equalsMember BT_UInt8 f = [lt|this.#{f} == other.#{f}|] + equalsMember BT_UInt16 f = [lt|this.#{f} == other.#{f}|] + equalsMember BT_UInt32 f = [lt|this.#{f} == other.#{f}|] + equalsMember BT_UInt64 f = [lt|this.#{f} == other.#{f}|] + equalsMember (BT_UserDefined a@Alias {} args) f = equalsMember (resolveAlias a args) f + equalsMember _ f = [lt|(this.#{f} == null && other.#{f} == null) || (this.#{f} != null && this.#{f}.equals(other.#{f}))|] + + +-- builds text for Object.hashCode() override +object_hashCode :: [Field] -> Maybe Type -> Text +object_hashCode fields structBase = [lt|@Override + public int hashCode() { + int result = 17; + #{newlineSep 2 hash hashInputs} + return result; + } +|] + where + hash codeExpr = [lt|result += #{codeExpr}; + result *= 0xeadbeef; + result ^= result >> 16;|] + + hashInputs = (hashBase structBase) ++ hashFields + + hashBase (Just _) = [[lt|super.hashCode()|]] + hashBase Nothing = [] + + hashFields = map (\Field {..} -> hashCode fieldType fieldName) fields + hashCode BT_Bool f = [lt|(#{f} ? 0 : 1)|] + hashCode BT_Int64 f = [lt|#{f} ^ (#{f} >>> 32)|] + hashCode BT_UInt64 f = [lt|#{f} ^ (#{f} >>> 32)|] + hashCode BT_Float f = [lt|org.bondlib.FloatingPointHelper.floatHashCode(#{f})|] + hashCode BT_Double f = [lt|org.bondlib.FloatingPointHelper.doubleHashCode(#{f})|] + hashCode BT_Int8 f = [lt|#{f}|] + hashCode BT_Int16 f = [lt|#{f}|] + hashCode BT_Int32 f = [lt|#{f}|] + hashCode BT_UInt8 f = [lt|#{f}|] + hashCode BT_UInt16 f = [lt|#{f}|] + hashCode BT_UInt32 f = [lt|#{f}|] + hashCode (BT_UserDefined a@Alias {} args) f = hashCode (resolveAlias a args) f + hashCode _ f = [lt|#{f} == null ? 0 : #{f}.hashCode()|] + + +-- We implement Externalizable, rather than Serializable, so that +-- ser/deserialization will result in a single call on the most derived class, +-- rather than one call for each type in the inheritance chain. By reading into +-- a byte[] instead of trying to deserialize from the ObjectInput{,Stream} we're +-- passed, we can start from a ByteArrayInputStream, which we already know how +-- to clone for Bonded fields. +-- +-- We write the length of the serialized data because we can't assume the +-- ObjectInput{,Stream} actually ends after the object we care about. +-- +-- serialVersionUID is always 0 so that Java will always delegate compatibility +-- checking of serialized data against current deserialization code to us. +javaNativeSerializationGlue :: String -> Text +javaNativeSerializationGlue declName = [lt| + // Java native serialization + private static final long serialVersionUID = 0L; + private #{declName} __deserializedInstance; + + @Override + public void writeExternal(java.io.ObjectOutput out) throws java.io.IOException { + final java.io.ByteArrayOutputStream outStream = new java.io.ByteArrayOutputStream(); + final org.bondlib.ProtocolWriter writer = new org.bondlib.CompactBinaryWriter(outStream, 1); + org.bondlib.Marshal.marshal(this, writer); + + final byte[] marshalled = outStream.toByteArray(); + out.write(0); // This type is not generic and has zero type parameters. + out.writeInt(marshalled.length); + out.write(marshalled); + } + + @Override + public void readExternal(java.io.ObjectInput in) throws java.io.IOException, java.lang.ClassNotFoundException { + if (in.read() != 0) throw new java.io.IOException("type is not generic, but serialized data has type parameters."); + final int marshalledLength = in.readInt(); + final byte[] marshalled = new byte[marshalledLength]; + in.readFully(marshalled); + + final java.io.ByteArrayInputStream inStream = new java.io.ByteArrayInputStream(marshalled); + this.__deserializedInstance = org.bondlib.Unmarshal.unmarshal(inStream, getBondType()).deserialize(); + } + + private Object readResolve() throws java.io.ObjectStreamException { + return this.__deserializedInstance; + } + // end Java native serialization + |] + + +javaNativeSerializationUnimpl :: Text +javaNativeSerializationUnimpl = [lt| + // Java native serialization + @Override + public void writeExternal(java.io.ObjectOutput out) throws java.io.IOException { + throw new java.lang.IllegalArgumentException("java.io.Serializable support is not implemented for generic types"); + } + + @Override + public void readExternal(java.io.ObjectInput in) throws java.io.IOException, java.lang.ClassNotFoundException { + // This may actually fail before reaching this line with an InvalidClassException because + // generic types don't have the nullary constructor required by the Java serialization + // framework. + throw new java.lang.IllegalArgumentException("java.io.Serializable support is not implemented for generic types"); + } + // end Java native serialization + |] + +-- Template for struct -> Java class. +class_java :: MappingContext -> [Import] -> Declaration -> Text +class_java java _ declaration = [lt| +package #{javaPackage}; +#{typeDefinition declaration} +|] + where + javaType = getTypeName java + javaPackage = sepBy "." toText $ getNamespace java + + -- struct -> Java class + typeDefinition s@Struct {..} = [lt| +#{generatedClassAnnotations} +public class #{typeNameWithParams declName declParams}#{maybe interface baseClass structBase} { + #{ifThenElse (null declParams) mempty (makeStructMember_GenericBondTypeBuilder declName declParams)} + private static final class StructBondTypeImpl#{typeParamAnglesNameList declParams} extends #{typeDescriptorNameWithParams declName declParams} { + #{makeStructBondTypeMember_StructBondTypeBuilderImpl declName declParams} + + #{doubleLineSep 2 fieldDescriptorFieldDecl structFields} + + private StructBondTypeImpl(org.bondlib.GenericTypeSpecialization genericTypeSpecialization) { + super(genericTypeSpecialization); + } + #{makeStructBondTypeMember_initialize java declParams structFields structBase} + + @Override + public final java.lang.String getName() { + return "#{declName}"; + } + + @Override + public final java.lang.String getQualifiedName() { + return "#{qualifiedDeclaredTypeName idl s}"; + } + + @Override + public final java.lang.Class<#{typeNameWithParams declName declParams}> getValueClass() { + return (java.lang.Class<#{typeNameWithParams declName declParams}>) (java.lang.Class) #{declName}.class; + } + + @Override + public final #{typeNameWithParams declName declParams} newInstance() { + return new #{typeNameWithParams declName declParams}(#{ifThenElse (null declParams) mempty thisText}); + } + #{makeStructBondTypeMember_serializeStructFields declName declParams structFields} + #{makeStructBondTypeMember_deserializeStructFields_tagged declName declParams structFields} + #{makeStructBondTypeMember_deserializeStructFields_untagged declName declParams structFields} + #{makeStructBondTypeMember_initializeStructFields declName declParams structFields} + #{makeStructBondTypeMember_cloneStructFields declName declParams structFields} + } + + #{bondTypeStaticVariableDecl} + + public static void initializeBondType() { + StructBondTypeImpl.StructBondTypeBuilderImpl.register(); + } + + static { + initializeBondType(); + } + #{bondTypeDescriptorInstanceVariableDecl} + + #{ifThenElse (null declParams) (javaNativeSerializationGlue declName) javaNativeSerializationUnimpl} + + #{doubleLineSep 1 publicFieldDecl structFields} + #{publicConstructorDecl} + #{object_equals declName structFields structBase} + #{object_hashCode structFields structBase} + @Override + public org.bondlib.StructBondType<? extends #{typeNameWithParams declName declParams}> getBondType() { + return #{getBondTypeReturnValue}; + } +}|] + where + idl = MappingContext idlTypeMapping [] [] [] + interface = [lt| implements org.bondlib.BondSerializable|] + baseClass x = [lt| extends #{javaType x}|] + publicFieldDecl Field {..} = [lt|public #{javaType fieldType} #{fieldName};|] + fieldDescriptorFieldDecl Field {..} = [lt|private #{structFieldDescriptorTypeName java fieldType} #{fieldName};|] + bondTypeStaticVariableDecl = if null declParams + then [lt|public static final org.bondlib.StructBondType<#{declName}> BOND_TYPE = new StructBondTypeImpl.StructBondTypeBuilderImpl().getInitializedFromCache();|] + else bondTypeStaticVariableDeclAsGenericBondTypeBuilder declName declParams + bondTypeDescriptorInstanceVariableDecl = if null declParams + then mempty + else [lt|private final StructBondTypeImpl#{typeParamAnglesNameList declParams} __genericType;|] + getBondTypeReturnValue = if null declParams + then [lt|BOND_TYPE|] + else [lt|this.__genericType|] + publicConstructorDecl = if null declParams + then publicConstructorDeclForNonGenericStruct java declName structBase + else publicConstructorDeclForGenericStruct java declName declParams structBase + + thisText = "this" :: Text + + typeDefinition _ = mempty
+ src/Language/Bond/Codegen/Java/Enum_java.hs view
@@ -0,0 +1,143 @@+-- Copyright (c) Microsoft. All rights reserved. +-- Licensed under the MIT license. See LICENSE file in the project root +-- for full license information. + +{-# LANGUAGE QuasiQuotes, OverloadedStrings, RecordWildCards #-} + +module Language.Bond.Codegen.Java.Enum_java + ( enum_java + ) where + +import Prelude +import Data.Text.Lazy (Text) +import Text.Shakespeare.Text +import Language.Bond.Syntax.Types +import Language.Bond.Util +import Language.Bond.Codegen.TypeMapping +import Language.Bond.Codegen.Util +import qualified Language.Bond.Codegen.Java.Util as Java + +-- Template for enum -> Java enum-like class. +enum_java :: MappingContext -> Declaration -> Text +enum_java java declaration = [lt| +package #{javaPackage}; + +#{typeDefinition declaration} +|] + where + javaPackage = sepBy "." toText $ getNamespace java + + typeDefinition Enum {..} = [lt| +#{Java.generatedClassAnnotations} +public final class #{declName} implements org.bondlib.BondEnum<#{declName}> { + + public static final class Values { + private Values() {} + + #{newlineSep 2 constantIntValueDecl enumConstantsWithInt} + } + + private static final class EnumBondTypeImpl extends org.bondlib.EnumBondType<#{declName}> { + + @Override + public java.lang.Class<#{declName}> getValueClass() { return #{declName}.class; } + + @Override + public final #{declName} getEnumValue(int value) { return get(value); } + } + + public static final org.bondlib.EnumBondType<#{declName}> BOND_TYPE = new EnumBondTypeImpl(); + + #{newlineSep 1 constantObjectDecl enumConstantsWithInt} + + public final int value; + + private final java.lang.String label; + + private #{declName}(int value, java.lang.String label) { this.value = value; this.label = label; } + + @Override + public final int getValue() { return this.value; } + + @Override + public final java.lang.String getLabel() { return this.label; } + + @Override + public final org.bondlib.EnumBondType<#{declName}> getBondType() { return BOND_TYPE; } + + @Override + public final int compareTo(#{declName} o) { return this.value < o.value ? -1 : (this.value > o.value ? 1 : 0); } + + @Override + public final boolean equals(java.lang.Object other) { return (other instanceof #{declName}) && (this.value == ((#{declName}) other).value); } + + @Override + public final int hashCode() { return this.value; } + + @Override + public final java.lang.String toString() { return this.label != null ? this.label : ("#{declName}(" + java.lang.String.valueOf(this.value) + ")"); } + + public static #{declName} get(int value) { + switch (value) { + #{newlineSep 3 switchCaseConstantMapping enumConstantsWithIntDistinct} + default: return new #{declName}(value, null); + } + } + + public static #{declName} valueOf(java.lang.String str) { + if (str == null) { + throw new java.lang.IllegalArgumentException("Argument 'str' must not be null."); + #{newlineSepEnd 2 parseCaseConstantMapping enumConstants}} else { + throw new java.lang.IllegalArgumentException("Invalid '#{declName}' enum value: '" + str + "'."); + } + } +}|] + where + -- constant object + constantObjectDecl c@Constant {..} = + [lt|public static final #{declName} #{constantName} = #{enumObjectAssigmentValue c};|] + + -- constant int + constantIntValueDecl Constant {..} = let value x = [lt|#{x}|] in + [lt|public static final int #{constantName} = #{optional value constantValue};|] + + -- switch cases that map int to object + switchCaseConstantMapping Constant {..} = + [lt|case Values.#{constantName}: return #{constantName};|] + + -- parse cases that map string to object + parseCaseConstantMapping Constant {..} = + [lt|} else if (str.equals("#{constantName}")) { + return #{constantName};|] + + -- Process constants to make sure every constant value is set (either explicit or auto-generated). + -- TODO: auto-generation of constant values should be handled earlier, once for all languages. + enumConstantsWithInt = fixEnumWithInt 0 enumConstants [] + + fixEnumWithInt :: Int -> [Constant] -> [Constant] -> [Constant] + fixEnumWithInt _ [] result = reverse result + fixEnumWithInt nextInt (h:r) result = case constantValue h of + Just n -> let fixedN = (fromInteger (Java.twosComplement 32 (toInteger n))) in + fixEnumWithInt (fixedN + 1) r ((Constant (constantName h) (Just fixedN)):result) + Nothing -> fixEnumWithInt (nextInt + 1) r ((Constant (constantName h) (Just nextInt)):result) + + -- Filter a list of constants, leaving a list of constants with distinct values. + -- If several constants in the input list share a value, the first one that appears will be the one that appears in the output list. + enumConstantsWithIntDistinct = findEnumConstantsDistinct enumConstantsWithInt [] + + findEnumConstantsDistinct :: [Constant] -> [Maybe Int] -> [Constant] + findEnumConstantsDistinct [] _ = [] + findEnumConstantsDistinct (h:r) keys = if elem (constantValue h) keys + then findEnumConstantsDistinct r keys + else h : findEnumConstantsDistinct r ((constantValue h):keys) + + -- The RHS value to assign to an enum object. If an enum element is the first instance with a particular value, + -- this function will return an instantiation. If it isn't, this function will return a reference to the first enum object with the same value. + enumObjectAssigmentValue :: Constant -> Text + enumObjectAssigmentValue enumConstant = + let firstDeclaredEnumConstant = head (filter (\c -> (constantValue c) == (constantValue enumConstant)) enumConstantsWithIntDistinct) in + if firstDeclaredEnumConstant == enumConstant + then [lt|new #{declName}(Values.#{constantName enumConstant}, "#{constantName enumConstant}")|] + else [lt|#{constantName firstDeclaredEnumConstant}|] + + typeDefinition _ = mempty
+ src/Language/Bond/Codegen/Java/Util.hs view
@@ -0,0 +1,73 @@+-- Copyright (c) Microsoft. All rights reserved. +-- Licensed under the MIT license. See LICENSE file in the project root for full license information. + +{-# LANGUAGE QuasiQuotes, OverloadedStrings, RecordWildCards #-} + +module Language.Bond.Codegen.Java.Util + ( qualifiedDeclaredTypeName + , generatedClassAnnotations + , modifierConstantName + , isPrimitiveNonEnumBondType + , isPrimitiveBondType + , isGenericBondStructType + , twosComplement + ) where + +import Prelude +import Data.List (intercalate) +import Data.Text.Lazy (Text) +import Text.Shakespeare.Text +import Language.Bond.Syntax.Types +import Language.Bond.Syntax.Util +import Language.Bond.Codegen.TypeMapping +import Language.Bond.Codegen.Util() + +-- returns the fully qualified name for a declaration +qualifiedDeclaredTypeName :: MappingContext -> Declaration -> String +qualifiedDeclaredTypeName java d = intercalate "." $ getDeclNamespace java d ++ [declName d] + +-- returns the Java annotations for a generated class +generatedClassAnnotations :: Text +generatedClassAnnotations = [lt|@javax.annotation.Generated("gbc")|] + +-- returns the qualified name of Modifier constant +modifierConstantName :: Modifier -> Text +modifierConstantName Optional = [lt|org.bondlib.Modifier.Optional|] +modifierConstantName Required = [lt|org.bondlib.Modifier.Required|] +modifierConstantName RequiredOptional = [lt|org.bondlib.Modifier.RequiredOptional|] + +-- returns a value indicating whether a type is a non-enum Bond primitive type +isPrimitiveNonEnumBondType :: Type -> Bool +isPrimitiveNonEnumBondType BT_Int8 = True +isPrimitiveNonEnumBondType BT_Int16 = True +isPrimitiveNonEnumBondType BT_Int32 = True +isPrimitiveNonEnumBondType BT_Int64 = True +isPrimitiveNonEnumBondType BT_UInt8 = True +isPrimitiveNonEnumBondType BT_UInt16 = True +isPrimitiveNonEnumBondType BT_UInt32 = True +isPrimitiveNonEnumBondType BT_UInt64 = True +isPrimitiveNonEnumBondType BT_Float = True +isPrimitiveNonEnumBondType BT_Double = True +isPrimitiveNonEnumBondType BT_Bool = True +isPrimitiveNonEnumBondType BT_String = True +isPrimitiveNonEnumBondType BT_WString = True +isPrimitiveNonEnumBondType BT_MetaName = True +isPrimitiveNonEnumBondType BT_MetaFullName = True +isPrimitiveNonEnumBondType (BT_UserDefined a@Alias {} args) = isPrimitiveNonEnumBondType (resolveAlias a args) +isPrimitiveNonEnumBondType _ = False + +-- returns a value indicating whether a type is a Bond primitive type or enum +isPrimitiveBondType :: Type -> Bool +isPrimitiveBondType (BT_UserDefined Enum {..} _) = True +isPrimitiveBondType t = isPrimitiveNonEnumBondType t + +-- returns a value indicating whether a type is a generic struct type with generic type parameters +isGenericBondStructType :: Type -> Bool +isGenericBondStructType (BT_UserDefined Struct {..} _) = not (null declParams) +isGenericBondStructType _ = False + +-- takes a bit count and a number and returns its two's complement +twosComplement :: Integer -> Integer -> Integer +twosComplement bitCount value = if value < (2 ^ (bitCount - 1)) + then value + else value - (2 ^ bitCount)
src/Language/Bond/Codegen/Templates.hs view
@@ -41,19 +41,18 @@ , apply_h , apply_cpp , Protocol(..) - -- ** C++ Comm - , comm_h - , comm_cpp , grpc_h , grpc_cpp -- ** C# , FieldMapping(..) , StructMapping(..) + , ConstructorOptions(..) , types_cs - , comm_interface_cs - , comm_proxy_cs - , comm_service_cs , grpc_cs + -- ** Java + , JavaFieldMapping(..) + , class_java + , enum_java ) where @@ -64,13 +63,12 @@ import Language.Bond.Codegen.Cpp.Reflection_h import Language.Bond.Codegen.Cpp.Types_cpp import Language.Bond.Codegen.Cpp.Types_h -import Language.Bond.Codegen.Cpp.Comm_cpp -import Language.Bond.Codegen.Cpp.Comm_h import Language.Bond.Codegen.Cpp.Grpc_cpp import Language.Bond.Codegen.Cpp.Grpc_h import Language.Bond.Codegen.Cs.Types_cs -import Language.Bond.Codegen.Cs.Comm_cs import Language.Bond.Codegen.Cs.Grpc_cs +import Language.Bond.Codegen.Java.Class_java +import Language.Bond.Codegen.Java.Enum_java -- redundant imports for haddock import Language.Bond.Codegen.TypeMapping import Language.Bond.Syntax.Types
src/Language/Bond/Codegen/TypeMapping.hs view
@@ -23,8 +23,11 @@ , idlTypeMapping , cppTypeMapping , cppCustomAllocTypeMapping + , cppExpandAliasesTypeMapping , csTypeMapping , csCollectionInterfacesTypeMapping + , javaTypeMapping + , javaBoxedTypeMapping -- * Alias mapping -- -- | <https://microsoft.github.io/bond/manual/compiler.html#type-aliases Type aliases> @@ -42,6 +45,7 @@ -- * Name builders , getTypeName , getInstanceTypeName + , getElementTypeName , getAnnotatedTypeName , getDeclTypeName , getQualifiedName @@ -52,6 +56,7 @@ -- * TypeMapping helper functions , elementTypeName , aliasTypeName + , getAliasDeclTypeName , declTypeName , declQualifiedTypeName ) where @@ -119,12 +124,21 @@ where fix' = fixSyntax $ typeMapping c +getAliasDeclTypeName :: MappingContext -> Declaration -> Builder +getAliasDeclTypeName c d = fix' $ runReader (aliasDeclTypeName d) c + where + fix' = fixSyntax $ typeMapping c + -- | Builds the name to be used when instantiating a 'Type'. The instance type -- name may be different than the type name returned by 'getTypeName' when the -- latter is an interface. getInstanceTypeName :: MappingContext -> Type -> Builder getInstanceTypeName c t = runReader (instanceTypeName t) c +-- | Builds the name to be used when instantiating an element 'Type'. +getElementTypeName :: MappingContext -> Type -> Builder +getElementTypeName c t = runReader (elementTypeName t) c + -- | Builds the annotated name of a 'Type'. The type annotations are used to -- express type information about a Bond type that doesn't directly map to -- the target language type system (e.g. distinction between a nullable and @@ -162,17 +176,25 @@ cppTypeMapping -- | C++ type name mapping using a custom allocator. -cppCustomAllocTypeMapping :: ToText a => a -> TypeMapping -cppCustomAllocTypeMapping alloc = TypeMapping +cppCustomAllocTypeMapping :: ToText a => Bool -> a -> TypeMapping +cppCustomAllocTypeMapping scoped alloc = TypeMapping (Just Cpp) "::" "::" - (cppTypeCustomAlloc $ toText alloc) + (cppTypeCustomAlloc scoped $ toText alloc) cppSyntaxFix - (cppCustomAllocTypeMapping alloc) - (cppCustomAllocTypeMapping alloc) - (cppCustomAllocTypeMapping alloc) + (cppCustomAllocTypeMapping scoped alloc) + (cppCustomAllocTypeMapping scoped alloc) + (cppCustomAllocTypeMapping scoped alloc) +cppExpandAliasesTypeMapping :: TypeMapping -> TypeMapping +cppExpandAliasesTypeMapping m = m + { mapType = cppTypeExpandAliases $ mapType m + , instanceMapping = cppExpandAliasesTypeMapping $ instanceMapping m + , elementMapping = cppExpandAliasesTypeMapping $ elementMapping m + , annotatedMapping = cppExpandAliasesTypeMapping $ annotatedMapping m + } + -- | The default C# type name mapping. csTypeMapping :: TypeMapping csTypeMapping = TypeMapping @@ -212,6 +234,30 @@ csAnnotatedTypeMapping csAnnotatedTypeMapping +-- | The default Java type name mapping. +javaTypeMapping :: TypeMapping +javaTypeMapping = TypeMapping + (Just Java) + "" + "." + javaType + id + javaTypeMapping + javaBoxedTypeMapping + javaTypeMapping + +-- | Java type mapping that boxes all primitives. +javaBoxedTypeMapping :: TypeMapping +javaBoxedTypeMapping = TypeMapping + (Just Java) + "" + "." + javaBoxedType + id + javaTypeMapping + javaBoxedTypeMapping + javaTypeMapping + infixr 6 <<>> (<<>>) :: (Monoid r, Monad m) => m r -> m r -> m r @@ -243,7 +289,7 @@ localWith :: (TypeMapping -> TypeMapping) -> TypeNameBuilder -> TypeNameBuilder localWith f = local $ \c -> c { typeMapping = f $ typeMapping c } --- | Builder for nested element types (e.g. list elements) in context of 'TypeNameBuilder' monad. +-- | Builder for nested element types (e.g. list elements) in context of 'TypeNameBuilder' monad. -- Used to implement 'mapType' function of 'TypeMapping'. elementTypeName :: Type -> TypeNameBuilder elementTypeName = localWith elementMapping . typeName @@ -303,6 +349,28 @@ fragment (Fragment s) = pureText s fragment (Placeholder i) = typeName $ args !! i +aliasDeclTypeName :: Declaration -> TypeNameBuilder +aliasDeclTypeName a@Alias {..} = do + ctx <- ask + case findAliasMapping ctx a of + Just AliasMapping {..} -> foldr ((<<>>) . fragment) (pure mempty) aliasTemplate + Nothing -> typeName aliasType + where + fragment (Fragment s) = pureText s + fragment (Placeholder i) = pureText $ paramName $ declParams !! i +aliasDeclTypeName _ = error "aliasDeclTypeName: impossible happened." + +-- | Builder for the type alias element name in context of 'TypeNameBuilder' monad. +aliasElementTypeName :: Declaration -> [Type] -> TypeNameBuilder +aliasElementTypeName a args = do + ctx <- ask + case findAliasMapping ctx a of + Just AliasMapping {..} -> foldr ((<<>>) . fragment) (pure mempty) aliasTemplate + Nothing -> elementTypeName $ resolveAlias a args + where + fragment (Fragment s) = pureText s + fragment (Placeholder i) = elementTypeName $ args !! i + -- IDL type mapping idlType :: Type -> TypeNameBuilder idlType BT_Int8 = pure "int8" @@ -360,34 +428,37 @@ cppType (BT_Map key value) = "std::map<" <>> elementTypeName key <<>> ", " <>> elementTypeName value <<> ">" cppType (BT_Bonded type_) = "::bond::bonded<" <>> elementTypeName type_ <<> ">" cppType (BT_TypeParam param) = pureText $ paramName param -cppType (BT_UserDefined a@Alias {..} args) = aliasTypeName a args cppType (BT_UserDefined decl args) = declQualifiedTypeName decl <<>> (angles <$> commaSepTypeNames args) -- C++ type mapping with custom allocator -cppTypeCustomAlloc :: Builder -> Type -> TypeNameBuilder -cppTypeCustomAlloc alloc BT_String = pure $ "std::basic_string<char, std::char_traits<char>, typename std::allocator_traits<" <> alloc <> ">::template rebind_alloc<char> >" -cppTypeCustomAlloc alloc BT_WString = pure $ "std::basic_string<wchar_t, std::char_traits<wchar_t>, typename std::allocator_traits<" <> alloc <> ">::template rebind_alloc<wchar_t> >" -cppTypeCustomAlloc alloc BT_MetaName = cppTypeCustomAlloc alloc BT_String -cppTypeCustomAlloc alloc BT_MetaFullName = cppTypeCustomAlloc alloc BT_String -cppTypeCustomAlloc alloc (BT_List element) = "std::list<" <>> elementTypeName element <<>> ", " <>> allocator alloc element <<> ">" -cppTypeCustomAlloc alloc (BT_Nullable element) | isStruct element = "::bond::nullable<" <>> elementTypeName element <<> ", " <> alloc <> ">" -cppTypeCustomAlloc _lloc (BT_Nullable element) = "::bond::nullable<" <>> elementTypeName element <<> ">" -cppTypeCustomAlloc alloc (BT_Vector element) = "std::vector<" <>> elementTypeName element <<>> ", " <>> allocator alloc element <<> ">" -cppTypeCustomAlloc alloc (BT_Set element) = "std::set<" <>> elementTypeName element <<>> comparer element <<>> allocator alloc element <<> ">" -cppTypeCustomAlloc alloc (BT_Map key value) = "std::map<" <>> elementTypeName key <<>> ", " <>> elementTypeName value <<>> comparer key <<>> pairAllocator alloc key value <<> ">" -cppTypeCustomAlloc _ t = cppType t +cppTypeCustomAlloc :: Bool -> Builder -> Type -> TypeNameBuilder +cppTypeCustomAlloc scoped alloc BT_String = "std::basic_string<char, std::char_traits<char>, " <>> rebindAllocator scoped alloc (pure "char") <<> " >" +cppTypeCustomAlloc scoped alloc BT_WString = "std::basic_string<wchar_t, std::char_traits<wchar_t>, " <>> rebindAllocator scoped alloc (pure "wchar_t") <<> " >" +cppTypeCustomAlloc scoped alloc BT_MetaName = cppTypeCustomAlloc scoped alloc BT_String +cppTypeCustomAlloc scoped alloc BT_MetaFullName = cppTypeCustomAlloc scoped alloc BT_String +cppTypeCustomAlloc scoped alloc (BT_List element) = "std::list<" <>> elementTypeName element <<>> ", " <>> allocator scoped alloc element <<> ">" +cppTypeCustomAlloc scoped alloc (BT_Vector element) = "std::vector<" <>> elementTypeName element <<>> ", " <>> allocator scoped alloc element <<> ">" +cppTypeCustomAlloc scoped alloc (BT_Set element) = "std::set<" <>> elementTypeName element <<>> comparer element <<>> allocator scoped alloc element <<> ">" +cppTypeCustomAlloc scoped alloc (BT_Map key value) = "std::map<" <>> elementTypeName key <<>> ", " <>> elementTypeName value <<>> comparer key <<>> pairAllocator scoped alloc key value <<> ">" +cppTypeCustomAlloc _ _ t = cppType t +cppTypeExpandAliases :: (Type -> TypeNameBuilder) -> Type -> TypeNameBuilder +cppTypeExpandAliases _ (BT_UserDefined a@Alias {..} args) = aliasTypeName a args +cppTypeExpandAliases m t = m t + comparer :: Type -> TypeNameBuilder comparer t = ", std::less<" <>> elementTypeName t <<> ">, " -allocator :: Builder -> Type -> TypeNameBuilder -allocator alloc element = - "typename std::allocator_traits<" <>> alloc <>> ">::template rebind_alloc<" <>> elementTypeName element <<> ">" +rebindAllocator :: Bool -> Builder -> TypeNameBuilder -> TypeNameBuilder +rebindAllocator False alloc element = "typename std::allocator_traits<" <>> alloc <>> ">::template rebind_alloc<" <>> element <<> ">" +rebindAllocator True alloc element = "std::scoped_allocator_adaptor<" <>> rebindAllocator False alloc element <<> " >" -pairAllocator :: Builder -> Type -> Type -> TypeNameBuilder -pairAllocator alloc key value = - "typename std::allocator_traits<" <>> alloc <>> ">::template rebind_alloc<" <>> "std::pair<const " <>> elementTypeName key <<>> ", " <>> elementTypeName value <<> "> >" +allocator :: Bool -> Builder -> Type -> TypeNameBuilder +allocator scoped alloc element = rebindAllocator scoped alloc $ elementTypeName element +pairAllocator :: Bool -> Builder -> Type -> Type -> TypeNameBuilder +pairAllocator scoped alloc key value = rebindAllocator scoped alloc $ "std::pair<const " <>> elementTypeName key <<>> ", " <>> elementTypeName value <<> "> " + cppSyntaxFix :: Builder -> Builder cppSyntaxFix = fromLazyText . snd . L.foldr fixInvalid (' ', mempty) . toLazyText where @@ -450,4 +521,64 @@ | otherwise = typeName $ resolveAlias a args csTypeAnnotation _ (BT_UserDefined decl args) = declTypeName decl <<>> (angles <$> commaSepTypeNames args) csTypeAnnotation m t = m t + + +-- Java type mapping +javaType :: Type -> TypeNameBuilder +javaType BT_Int8 = pure "byte" +javaType BT_Int16 = pure "short" +javaType BT_Int32 = pure "int" +javaType BT_Int64 = pure "long" +javaType BT_UInt8 = pure "byte" +javaType BT_UInt16 = pure "short" +javaType BT_UInt32 = pure "int" +javaType BT_UInt64 = pure "long" +javaType BT_Float = pure "float" +javaType BT_Double = pure "double" +javaType BT_Bool = pure "boolean" +javaType BT_String = pure "java.lang.String" +javaType BT_WString = pure "java.lang.String" +javaType BT_MetaName = pure "java.lang.String" +javaType BT_MetaFullName = pure "java.lang.String" +javaType BT_Blob = pure "org.bondlib.Blob" +javaType (BT_IntTypeArg x) = pureText x +javaType (BT_Maybe BT_Int8) = pure "org.bondlib.SomethingByte" +javaType (BT_Maybe BT_Int16) = pure "org.bondlib.SomethingShort" +javaType (BT_Maybe BT_Int32) = pure "org.bondlib.SomethingInteger" +javaType (BT_Maybe BT_Int64) = pure "org.bondlib.SomethingLong" +javaType (BT_Maybe BT_UInt8) = pure "org.bondlib.SomethingByte" +javaType (BT_Maybe BT_UInt16) = pure "org.bondlib.SomethingShort" +javaType (BT_Maybe BT_UInt32) = pure "org.bondlib.SomethingInteger" +javaType (BT_Maybe BT_UInt64) = pure "org.bondlib.SomethingLong" +javaType (BT_Maybe BT_Float) = pure "org.bondlib.SomethingFloat" +javaType (BT_Maybe BT_Double) = pure "org.bondlib.SomethingDouble" +javaType (BT_Maybe BT_Bool) = pure "org.bondlib.SomethingBoolean" +javaType (BT_UserDefined a@Alias {} args) = javaType (resolveAlias a args) +javaType (BT_Maybe (BT_UserDefined a@Alias {} args)) = javaType (BT_Maybe (resolveAlias a args)) +javaType (BT_Maybe fieldType) = "org.bondlib.SomethingObject<" <>> javaBoxedType fieldType <<> ">" +javaType (BT_Nullable elementType) = javaBoxedType elementType +javaType (BT_List elementType) = "java.util.List<" <>> elementTypeName elementType <<> ">" +javaType (BT_Vector elementType) = "java.util.List<" <>> elementTypeName elementType <<> ">" +javaType (BT_Set elementType) = "java.util.Set<" <>> elementTypeName elementType <<> ">" +javaType (BT_Map keyType valueType) = "java.util.Map<" <>> elementTypeName keyType <<>> ", " <>> elementTypeName valueType <<> ">" +javaType (BT_TypeParam param) = pureText $ paramName param +javaType (BT_Bonded structType) = "org.bondlib.Bonded<" <>> javaBoxedType structType <<> ">" +javaType (BT_UserDefined decl args) = + declQualifiedTypeName decl <<>> (angles <$> localWith (const javaBoxedTypeMapping) (commaSepTypeNames args)) + +-- Java type mapping to a reference type with primitive types boxed +javaBoxedType :: Type -> TypeNameBuilder +javaBoxedType BT_Int8 = pure "java.lang.Byte" +javaBoxedType BT_Int16 = pure "java.lang.Short" +javaBoxedType BT_Int32 = pure "java.lang.Integer" +javaBoxedType BT_Int64 = pure "java.lang.Long" +javaBoxedType BT_UInt8 = pure "java.lang.Byte" +javaBoxedType BT_UInt16 = pure "java.lang.Short" +javaBoxedType BT_UInt32 = pure "java.lang.Integer" +javaBoxedType BT_UInt64 = pure "java.lang.Long" +javaBoxedType BT_Float = pure "java.lang.Float" +javaBoxedType BT_Double = pure "java.lang.Double" +javaBoxedType BT_Bool = pure "java.lang.Boolean" +javaBoxedType (BT_UserDefined a@Alias {} args) = aliasElementTypeName a args +javaBoxedType t = javaType t
src/Language/Bond/Codegen/Util.hs view
@@ -17,6 +17,7 @@ module Language.Bond.Codegen.Util ( commonHeader + , commaSep , newlineSep , commaLineSep , newlineSepEnd @@ -24,6 +25,10 @@ , doubleLineSep , doubleLineSepEnd , uniqueName + , uniqueNames + , indent + , newLine + , slashForward ) where import Data.Int (Int64) @@ -60,6 +65,10 @@ #{indent n}|] +-- | Separates elements of a list with a comma. +commaSep :: (a -> Text) -> [a] -> Text +commaSep = sepBy ", " + newlineSep, commaLineSep, newlineSepEnd, newlineBeginSep, doubleLineSep, doubleLineSepEnd :: Int64 -> (a -> Text) -> [a] -> Text @@ -89,13 +98,14 @@ -- | Returns common header for generated files using specified single-line -- comment lead character(s) and a file name. -commonHeader :: ToText a => a -> a -> Text -commonHeader c file = [lt| +commonHeader :: ToText a => a -> a -> a -> Text +commonHeader c input output = [lt| #{c}------------------------------------------------------------------------------ #{c} This code was generated by a tool. #{c} #{c} Tool : Bond Compiler #{showVersion version} -#{c} File : #{file} +#{c} Input filename: #{input} +#{c} Output filename: #{output} #{c} #{c} Changes to this file may cause incorrect behavior and will be lost when #{c} the code is regenerated. @@ -104,7 +114,7 @@ |] -- | Given an intended name and a list of already taken names, returns a --- unique name. Assumes that it's legal to appen digits to the end of the +-- unique name. Assumes that it's legal to append digits to the end of the -- intended name. uniqueName :: String -> [String] -> String uniqueName baseName taken = go baseName (0::Integer) @@ -112,3 +122,19 @@ | not (name `elem` taken) = name | otherwise = go newName (counter + 1) where newName = baseName ++ (show counter) + +-- | Given a list of names with duplicates and a list of reserved names, +-- create a list of unique names using the uniqueName function. +uniqueNames :: [String] -> [String] -> [String] +uniqueNames names reservedInit = reverse $ go names [] reservedInit + where + go [] acc _ = acc + go (name:remaining) acc reservedAcc = go remaining (newName:acc) (newName:reservedAcc) + where + newName = uniqueName name reservedAcc + +-- | Converts all file path slashes to forward slashes. +slashForward :: String -> String +slashForward path = map replace path + where replace '\\' = '/' + replace c = c
src/Language/Bond/Lexer.hs view
@@ -34,120 +34,179 @@ , stringLiteral , symbol , whiteSpace + , Environment(..) + , ImportResolver + , Symbols(..) + , Parser ) where -import Data.List import Control.Monad.Reader -import Text.ParserCombinators.Parsec -import qualified Text.Parsec.Token as P +import Control.Monad.State.Lazy +import Data.List +import Data.Void (Void) +import Language.Bond.Syntax.Types +import Text.Megaparsec +import Text.Megaparsec.Char +import qualified Text.Megaparsec.Char.Lexer as L -type LanguageDef st env = P.GenLanguageDef String st (ReaderT env IO) +-- parser state, mutable and global +data Symbols = + Symbols + { symbols :: [Declaration] -- list of structs, enums and aliases declared in the current and all imported files + , imports :: [FilePath] -- list of imported files + } -bondIdl :: LanguageDef st env -bondIdl = P.LanguageDef - { P.commentStart = "/*" - , P.commentEnd = "*/" - , P.commentLine = "//" - , P.nestedComments = True - , P.identStart = letter <|> char '_' - , P.identLetter = alphaNum <|> char '_' - , P.opStart = mzero - , P.opLetter = mzero - , P.reservedNames = - [ "blob" - , "bond_meta" - , "bonded" - , "bool" - , "class" - , "double" - , "enum" - , "false" - , "float" - , "import" - , "int16" - , "int32" - , "int64" - , "int8" - , "list" - , "map" - , "namespace" - , "nullable" - , "optional" - , "required" - , "required_optional" - , "Schema" - , "sealed" - , "service" - , "set" - , "string" - , "struct" - , "true" - , "uint16" - , "uint32" - , "uint64" - , "uint8" - , "using" - , "var" - , "vector" - , "view_of" - , "void" - , "wstring" - ] - , P.reservedOpNames = [] - , P.caseSensitive = True +type ImportResolver = + FilePath -- ^ path of the file containing the <https://microsoft.github.io/bond/manual/compiler.html#import-statements import statement> + -> FilePath -- ^ (usually relative) path of the imported file + -> IO (FilePath, String) -- ^ the resolver function returns the resolved path of the imported file and its content + +-- parser environment, immutable but contextual +data Environment = + Environment + { currentNamespaces :: [Namespace] -- namespace(s) in current context + , currentParams :: [TypeParam] -- type parameter(s) for current type (struct or alias) + , currentFile :: FilePath -- path of the current file + , resolveImport :: ImportResolver -- imports resolver } -lexer = P.makeTokenParser bondIdl +type Parser a = StateT Symbols (ParsecT Void String (ReaderT Environment IO)) a -angles = P.angles lexer -braces = P.braces lexer -brackets = P.brackets lexer -colon = P.colon lexer -comma = P.comma lexer -commaSep1 = P.commaSep1 lexer -decimal = P.decimal lexer -identifier = P.identifier lexer -integer = P.integer lexer -keyword = P.reserved lexer -lexeme = P.lexeme lexer -natural = P.natural lexer -parens = P.parens lexer -semi = P.semi lexer -semiSep = P.semiSep lexer -symbol = P.symbol lexer -whiteSpace = P.whiteSpace lexer +-- space consumer parser +sc :: Parser () +sc = L.space space1 lineCmnt blockCmnt + where + lineCmnt = L.skipLineComment "//" + blockCmnt = L.skipBlockComment "/*" "*/" -namespaceLexer = P.makeTokenParser bondIdl { P.reservedNames = delete "Schema" (P.reservedNames bondIdl) } -namespaceIdentifier = P.identifier namespaceLexer +-- consume whitespace after every lexeme +lexeme :: Parser a -> Parser a +lexeme = L.lexeme sc -equal = symbol "=" -semiEnd p = endBy p semi -commaEnd p = endBy p comma +-- list of reserved words +rws :: [String] +rws = [ "blob" + , "bond_meta" + , "bonded" + , "bool" + , "class" + , "double" + , "enum" + , "false" + , "float" + , "import" + , "int16" + , "int32" + , "int64" + , "int8" + , "list" + , "map" + , "namespace" + , "nullable" + , "optional" + , "required" + , "required_optional" + , "Schema" + , "sealed" + , "service" + , "set" + , "string" + , "struct" + , "true" + , "uint16" + , "uint32" + , "uint64" + , "uint8" + , "using" + , "var" + , "vector" + , "view_of" + , "void" + , "wstring" + ] + +angles :: Parser a -> Parser a +angles = between (symbol "<") (symbol ">") + +braces :: Parser a -> Parser a +braces = between (symbol "{") (symbol "}") + +brackets :: Parser a -> Parser a +brackets = between (symbol "[") (symbol "]") + +colon :: Parser String +colon = symbol ":" + +comma :: Parser String +comma = symbol "," + +commaSep1 p = sepBy1 p comma + +identifier' :: [String] -> Parser String +identifier' restricted = (lexeme . try) (p >>= check) + where + p = (:) <$> (letterChar <|> char '_') <*> many (alphaNumChar <|> char '_') + check x = if x `elem` restricted + then fail $ "keyword " ++ show x ++ " cannot be an identifier" + else return x + +identifier = identifier' rws + +decimal :: Parser Integer +decimal = lexeme L.decimal + +integer = L.signed sc natural + +keyword :: String -> Parser () +keyword w = lexeme (string w *> notFollowedBy (alphaNumChar <|> char '_')) + +hexadecimal :: Parser Integer +hexadecimal = lexeme . try $ char '0' >> char' 'x' >> L.hexadecimal + +octal :: Parser Integer +octal = lexeme . try $ char '0' >> char' 'o' >> L.octal + +natural = hexadecimal <|> octal <|> decimal + +parens :: Parser a -> Parser a +parens = between (symbol "(") (symbol ")") + +semi :: Parser String +semi = symbol ";" + +semiSep p = sepBy p semi + +symbol :: String -> Parser String +symbol = L.symbol sc + +whiteSpace = sc + +namespaceIdentifier = identifier' (delete "Schema" rws) + +equal = symbol "=" +semiEnd p = endBy p semi +commaEnd p = endBy p comma commaEnd1 p = endBy1 p comma semiOrComma = semi <|> comma -semiOrCommaSep p = sepBy p semiOrComma -semiOrCommaSep1 p = sepBy1 p semiOrComma -semiOrCommaEnd p = endBy p semiOrComma -semiOrCommaSepEnd p = sepEndBy p semiOrComma +semiOrCommaSep p = sepBy p semiOrComma +semiOrCommaSep1 p = sepBy1 p semiOrComma +semiOrCommaEnd p = endBy p semiOrComma +semiOrCommaSepEnd p = sepEndBy p semiOrComma semiOrCommaSepEnd1 p = sepEndBy1 p semiOrComma quote = symbol "\"" quotes = between quote quote -stringLiteral = P.stringLiteral lexer +stringLiteral :: Parser String +stringLiteral = char '"' >> manyTill L.charLiteral (char '"') unescapedStringLiteral = quotes $ many $ satisfy (/= '"') --- Can't use float from Text.Parsec.Token because it doesn't handle numbers --- starting with +/- sign. -float = do - s <- sign - f <- P.float lexer - return $ s f - where - sign = (char '-' >> return negate) - <|> (char '+' >> return id) - <|> return id +float' :: Parser Double +float' = lexeme L.float + +float :: Parser Double +float = L.signed sc float'
src/Language/Bond/Parser.hs view
@@ -21,67 +21,47 @@ ) where -import Data.Ord -import Data.List +import Control.Applicative +import Control.Monad.Reader +import Control.Monad.State.Lazy import Data.Function import Data.Int +import Data.List +import Data.Maybe (fromMaybe) +import Data.Ord +import Data.Void (Void) import Data.Word -import Control.Applicative -import Control.Monad.Reader -import Prelude -import Text.Parsec.Pos (initialPos) -import Text.Parsec hiding (many, optional, (<|>)) import Language.Bond.Lexer +import Language.Bond.Syntax.Internal import Language.Bond.Syntax.Types import Language.Bond.Syntax.Util -import Language.Bond.Syntax.Internal - --- parser state, mutable and global -data Symbols = - Symbols - { symbols :: [Declaration] -- list of structs, enums and aliases declared in the current and all imported files - , imports :: [FilePath] -- list of imported files - } - -type ImportResolver = - FilePath -- ^ path of the file containing the <https://microsoft.github.io/bond/manual/compiler.html#import-statements import statement> - -> FilePath -- ^ (usually relative) path of the imported file - -> IO (FilePath, String) -- ^ the resolver function returns the resolved path of the imported file and its content - --- parser environment, immutable but contextual -data Environment = - Environment - { currentNamespaces :: [Namespace] -- namespace(s) in current context - , currentParams :: [TypeParam] -- type parameter(s) for current type (struct or alias) - , currentFile :: FilePath -- path of the current file - , resolveImport :: ImportResolver -- imports resolver - } - -type Parser a = ParsecT String Symbols (ReaderT Environment IO) a +import Prelude +import Text.Megaparsec hiding (many, optional, (<|>)) +import Text.Megaparsec.Char (char) -- | Parses content of a schema definition file. parseBond :: - SourceName -- ^ source name, used only for error messages + String -- ^ source name, used only for error messages -> String -- ^ content of a schema file to parse -> FilePath -- ^ path of the file being parsed, used to resolve relative import paths -> ImportResolver -- ^ function to resolve and load imported files - -> IO (Either ParseError Bond) -- ^ function returns 'Bond' which represents the parsed abstract syntax tree + -> IO (Either (ParseError Char Void) Bond) -- ^ function returns 'Bond' which represents the parsed abstract syntax tree -- or 'ParserError' if parsing failed -parseBond s c f r = runReaderT (runParserT bond (Symbols [] []) s c) (Environment [] [] f r) +parseBond s c f r = runReaderT (runParserT (evalStateT bond (Symbols [] [])) s c) (Environment [] [] f r) -- parser for .bond files bond :: Parser Bond bond = do whiteSpace imports <- many import_ - namespaces <- many1 namespace + namespaces <- some namespace local (with namespaces) $ Bond imports namespaces <$> many declaration <* eof where with namespaces e = e { currentNamespaces = namespaces } import_ :: Parser Import import_ = do - i <- Import <$ keyword "import" <*> unescapedStringLiteral <?> "import statement" + i <- Import <$ keyword "import" <*> unescapedStringLiteral <* optional semi <?> "import statement" src <- getInput pos <- getPosition processImport i @@ -93,9 +73,9 @@ processImport (Import file) = do Environment { currentFile = currentFile, resolveImport = resolveImport } <- ask (path, content) <- liftIO $ resolveImport currentFile file - Symbols { imports = imports } <- getState + Symbols { imports = imports } <- get if path `elem` imports then return () else do - modifyState (\u -> u { imports = path:imports } ) + modify (\u -> u { imports = path:imports } ) setInput content setPosition $ initialPos path void $ local (\e -> e { currentFile = path }) bond @@ -103,21 +83,28 @@ -- parser for struct, enum or type alias declaration/definition declaration :: Parser Declaration declaration = do + -- When adding a new Declaration parser, order matters in the following command. + -- Parsers must fail to consume ANY token for the next parser to be able to successfully work + -- unless the parser is encapsulated in a try statement. For more info on try and <|> see: + -- https://hackage.haskell.org/package/megaparsec-6.2.0/docs/Text-Megaparsec.html#v:try decl <- try forward - <|> try struct - <|> try view - <|> try enum - <|> try alias - <|> try service + <|> alias + <|> (attributes >>= \a -> (service a <|> enum a <|> structDeclaration a)) updateSymbols decl <?> "declaration" return decl +structDeclaration :: [Attribute] -> Parser Declaration +structDeclaration attr = do + name <- keyword "struct" *> identifier <?> "struct or struct view definition" + decl <- view attr name <|> struct attr name + return decl + updateSymbols :: Declaration -> Parser () updateSymbols decl = do - (previous, symbols) <- partition (duplicateDeclaration decl) <$> symbols <$> getState + (previous, symbols) <- partition (duplicateDeclaration decl) <$> symbols <$> get case reconcile previous decl of (False, _) -> fail $ "The " ++ showPretty decl ++ " has been previously defined as " ++ showPretty (head previous) - (True, f) -> modifyState (f symbols) + (True, f) -> modify (f symbols) where reconcile [x@Forward {}] y@Struct {} = (paramsMatch x y, add y) reconcile [x@Forward {}] y@Forward {} = (paramsMatch x y, const id) @@ -141,7 +128,7 @@ where doFind = do namespaces <- asks currentNamespaces - Symbols { symbols = symbols } <- getState + Symbols { symbols = symbols } <- get case find (declMatching namespaces name) symbols of Just decl -> return decl Nothing -> fail $ "Unknown symbol: " ++ showQualifiedName name @@ -171,9 +158,9 @@ namespace = Namespace <$ keyword "namespace" <*> language <*> qualifiedName <* optional semi <?> "namespace declaration" where language = optional (keyword "cpp" *> pure Cpp + <|> keyword "csharp" *> pure Cs <|> keyword "cs" *> pure Cs - <|> keyword "java" *> pure Java - <|> keyword "csharp" *> pure Cs) + <|> keyword "java" *> pure Java) -- identifier optionally qualified with namespace qualifiedName :: Parser QualifiedName @@ -189,7 +176,7 @@ -- type alias alias :: Parser Declaration alias = do - name <- keyword "using" *> identifier <?> "alias definition" + name <- try (keyword "using") *> identifier <?> "alias definition" params <- parameters namespaces <- asks currentNamespaces local (with params) $ Alias namespaces name params <$ equal <*> type_ <* semi @@ -209,11 +196,9 @@ attribute = brackets (Attribute <$> qualifiedName <*> parens stringLiteral <?> "attribute") -- struct view parser -view :: Parser Declaration -view = do - attr <- attributes - name <- keyword "struct" *> identifier <?> "struct view definition" - decl <- keyword "view_of" *> qualifiedName >>= findStruct +view :: [Attribute] -> String -> Parser Declaration +view attr name = do + decl <- try (keyword "view_of") *> qualifiedName >>= findStruct <?> "struct view definition" fields <- braces $ semiOrCommaSepEnd1 identifier namespaces <- asks currentNamespaces Struct namespaces attr name (declParams decl) (structBase decl) (viewFields decl fields) <$ optional semi @@ -222,18 +207,19 @@ viewFields _ _ = error "view/viewFields: impossible happened." -- struct definition parser -struct :: Parser Declaration -struct = do - attr <- attributes - name <- keyword "struct" *> identifier <?> "struct definition" +struct :: [Attribute] -> String -> Parser Declaration +struct attr name = do params <- parameters namespaces <- asks currentNamespaces updateSymbols $ Forward namespaces name params local (with params) $ Struct namespaces attr name params <$> base <*> fields <* optional semi where base = optional (colon *> userType <?> "base struct") - fields = unique $ braces $ manySortedBy (comparing fieldOrdinal) (field <* semi) + fields = sortFields $ unique $ braces $ many (field <* semi) with params e = e { currentParams = params } + sortFields p = do + fields' <- p + return $ sortBy (comparing fieldOrdinal) fields' unique p = do fields' <- p case findDuplicatesBy fieldOrdinal fields' ++ findDuplicatesBy fieldName fields' of @@ -258,8 +244,8 @@ else fail "Field ordinal must be within the range 0-65535" modifier = option Optional (keyword "optional" *> pure Optional - <|> keyword "required" *> pure Required - <|> keyword "required_optional" *> pure RequiredOptional) + <|> keyword "required_optional" *> pure RequiredOptional + <|> keyword "required" *> pure Required) default_ = equal *> (keyword "true" *> pure (DefaultBool True) <|> keyword "false" *> pure (DefaultBool False) @@ -278,10 +264,10 @@ else Left "Invalid default value for field" -- enum definition parser -enum :: Parser Declaration -enum = Enum <$> asks currentNamespaces <*> attributes <*> name <*> consts <* optional semi <?> "enum definition" +enum :: [Attribute] -> Parser Declaration +enum attr = Enum <$> asks currentNamespaces <*> pure attr <*> name <*> consts <* optional semi <?> "enum definition" where - name = keyword "enum" *> (identifier <?> "enum identifier") + name = try (keyword "enum") *> identifier <?> "enum identifier" consts = braces (semiOrCommaSepEnd1 constant <?> "enum constant") constant = Constant <$> identifier <*> optional value value = equal *> (fromIntegral <$> integer) @@ -312,10 +298,9 @@ <|> keyword "nullable" *> angles (BT_Nullable <$> type_) <|> keyword "set" *> angles (BT_Set <$> keyType) <|> keyword "map" *> angles (BT_Map <$> keyType <* comma <*> type_) - <|> keyword "bonded" *> angles (BT_Bonded <$> userStruct) + <|> keyword "bonded" *> angles (BT_Bonded <$> userStructRef) where keyType = try (basicType <|> checkUserType isValidKeyType) <?> "scalar, string or enum" - userStruct = try (checkUserType isStruct) <?> "user defined struct" isValidKeyType t = isScalar t || isString t -- parser for user defined type (struct, enum, alias or type parameter) @@ -361,9 +346,11 @@ isParam [name] = (name ==) . paramName isParam _ = const False + + -- type parser type_ :: Parser Type -type_ = basicType <|> complexType <|> userType +type_ = (try basicType) <|> (try complexType) <|> (try userType) -- field type parser ftype :: Parser Type @@ -372,60 +359,87 @@ <|> type_ -- service definition parser -service :: Parser Declaration -service = do - attr <- attributes - name <- keyword "service" *> identifier <?> "service definition" +service :: [Attribute] -> Parser Declaration +service attr = do + name <- try (keyword "service") *> identifier <?> "service definition" params <- parameters namespaces <- asks currentNamespaces local (with params) $ Service namespaces attr name params <$> base <*> methods <* optional semi where base = optional (colon *> serviceType <?> "base service") with params e = e { currentParams = params } - methods = unique $ braces $ semiEnd (try event <|> try function) - unique p = do + methods = checkUniqueMethodNames $ braces $ semiEnd method + checkUniqueMethodNames p = do methods' <- p case findDuplicatesBy methodName methods' of [] -> return methods' Function {..}:_ -> fail $ "Duplicate definition of the function with name " ++ show methodName Event {..}:_ -> fail $ "Duplicate definition of the event with name " ++ show methodName -function :: Parser Method -function = Function <$> attributes <*> payload <*> identifier <*> input +method :: Parser Method +method = attributes >>= \a -> ((lookAhead (keyword "nothing") *> event a) <|> function a) -event :: Parser Method -event = Event <$> attributes <* keyword "nothing" <*> identifier <*> input +function :: [Attribute] -> Parser Method +function attr = Function attr <$> functionResultType <*> identifier <*> input + where functionResultType = methodTypeVoid <|> methodResultTypeStreaming <|> methodTypeUnary -input :: Parser (Maybe Type) -input = do - pld <- parens $ optional payload - case pld of - Nothing -> pure Nothing - Just m -> return m +event :: [Attribute] -> Parser Method +event attr = do + _ <- keyword "nothing" + methodName <- identifier + methodInput <- input + case methodInput of + (Streaming _) -> fail $ "Incompatible nothing return and streaming input in method " ++ show methodName + _ -> return (Event attr methodName methodInput) -payload :: Parser (Maybe Type) -payload = void_ <|> liftM Just userStruct - where - void_ = keyword "void" *> pure Nothing - userStruct = try (checkUserType isStruct) <?> "user defined struct" +input :: Parser MethodType +input = parens methodInputType + where methodInputType = (fromMaybe Void) <$> optional (methodTypeVoid <|> methodInputTypeStreaming <|> methodTypeUnary) +methodTypeVoid :: Parser MethodType +methodTypeVoid = try (keyword "void" *> pure Void) <?> "void method type" + +-- Whether the method type is streaming or is unary can be determined based on +-- context, but the context is different for result and input types. +-- +-- For result types, the keyword stream followed by a struct name AND THEN +-- an identifier indicates a streaming type. Two identifiers are required to +-- distinguish between the unary method "stream stream()" and the streaming +-- method "stream stream stream()". +-- +-- For input types, simply the keyword stream followed by a struct name is +-- enough to distinguish between the unary "foo(stream)" and the streaming +-- "foo(stream stream)". +methodResultTypeStreaming :: Parser MethodType +methodResultTypeStreaming = try (do + _ <- keyword "stream" + resultType <- userStructRef + _ <- lookAhead identifier + return (Streaming resultType)) <?> "streaming method type" + +methodInputTypeStreaming :: Parser MethodType +methodInputTypeStreaming = try (Streaming <$ keyword "stream" <*> userStructRef) <?> "streaming method type" + +methodTypeUnary :: Parser MethodType +methodTypeUnary = (Unary <$> userStructRef) <?> "unary method type" + -- helper methods checkUserType :: (Type -> Bool) -> Parser Type checkUserType check = do t <- userType - if (valid t) then return t else unexpected "type" + if (valid t) then return t else fail "unexpected type" where valid t = case t of BT_TypeParam _ -> True _ -> check t +userStructRef :: Parser Type +userStructRef = try (checkUserType isStruct) <?> "user defined struct reference" + findDuplicatesBy :: (Eq b) => (a -> b) -> [a] -> [a] findDuplicatesBy accessor xs = deleteFirstsBy ((==) `on` accessor) xs (nubBy ((==) `on` accessor) xs) -manySortedBy :: (a -> a -> Ordering) -> ParsecT s u m a -> ParsecT s u m [a] -manySortedBy = manyAccum . insertBy - -- default type validator (type checking, out-of-range, enforce default type) validDefaultType :: Type -> Maybe Default -> Bool validDefaultType (BT_UserDefined a@Alias {} args) d = validDefaultType (resolveAlias a args) d @@ -452,7 +466,6 @@ validDefaultType' _ _ = False -- checks whether an Integer is within the bounds of some other Integral and Bounded type. --- The value of the second paramater is never used: only its type is used. +-- The value of the second parameter is never used: only its type is used. isInBounds :: forall a. (Integral a, Bounded a) => Integer -> a -> Bool isInBounds value _ = value >= (toInteger (minBound :: a)) && value <= (toInteger (maxBound :: a)) -
src/Language/Bond/Syntax/Internal.hs view
@@ -10,6 +10,7 @@ , takeNamespace , isBaseField , metaField + , baseFields ) where import Data.Monoid @@ -51,3 +52,7 @@ isBaseField :: String -> Maybe Type -> Bool isBaseField name = getAny . optional (foldMapFields (Any.(name==).fieldName)) +-- If a Declaration is a Struct then return the Fields of its Parent +baseFields :: Declaration -> Maybe [Field] +baseFields Struct{..} = foldMapFields return <$> structBase +baseFields _ = Nothing
src/Language/Bond/Syntax/JSON.hs view
@@ -1,7 +1,7 @@ -- Copyright (c) Microsoft. All rights reserved. -- Licensed under the MIT license. See LICENSE file in the project root for full license information. -{-# LANGUAGE OverloadedStrings, RecordWildCards, TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings, QuasiQuotes, RecordWildCards, ScopedTypeVariables, TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| @@ -18,12 +18,16 @@ ) where +import Control.Applicative import Data.Aeson -import Data.Aeson.Types import Data.Aeson.TH -import Control.Applicative +import Data.Aeson.Types +import Data.HashMap.Strict (member) +import Data.Text.Lazy (unpack) +import Language.Bond.Syntax.Types hiding (MethodType(..)) +import qualified Language.Bond.Syntax.Types as BST (MethodType(..)) import Prelude -import Language.Bond.Syntax.Types +import Text.Shakespeare.Text (lt) -- $aeson -- @@ -137,7 +141,7 @@ toJSON (BT_IntTypeArg n) = object [ "type" .= String "constant" , "value" .= n - ] + ] toJSON (BT_TypeParam p) = object [ "type" .= String "parameter" , "value" .= p @@ -211,7 +215,7 @@ [ "fieldAttributes" .= fieldAttributes f , "fieldOrdinal" .= fieldOrdinal f , "fieldModifier" .= fieldModifier f - , "fieldType" .= fieldType f + , "fieldType" .= fieldType f , "fieldName" .= fieldName f , "fieldDefault" .= fieldDefault f ] @@ -260,6 +264,100 @@ , "declarations" .= bondDeclarations ] +instance ToJSON BST.MethodType where + toJSON BST.Void = Null + toJSON (BST.Unary t) = toJSON t + toJSON (BST.Streaming t) = toJSON t + +data MethodStreamingTag = Unary | Client | Server | Duplex deriving Show +$(deriveJSON defaultOptions ''MethodStreamingTag) + +methodStreamingTag :: BST.MethodType -> BST.MethodType -> MethodStreamingTag +methodStreamingTag input result = case (input, result) of + (BST.Streaming _, BST.Streaming _) -> Duplex + (BST.Streaming _, _) -> Client + (_, BST.Streaming _) -> Server + _ -> Unary + +instance ToJSON Method where + toJSON Event {..} = object + [ "tag" .= String "Event" + , "methodName" .= methodName + , "methodAttributes" .= methodAttributes + , "methodInput" .= methodInput + ] + toJSON Function {..} = object + [ "tag" .= String "Function" + , "methodName" .= methodName + , "methodAttributes" .= methodAttributes + , "methodResult" .= methodResult + , "methodInput" .= methodInput + , "methodStreaming" .= (methodStreamingTag methodInput methodResult) + ] + +instance FromJSON Method where + parseJSON = withObject "Method" (\o -> do + tag <- o .: "tag" + methodName :: String <- o .:? "methodName" .!= "<unknown>" + case tag of + (String "Event") -> modifyFailure ((unpack [lt|Parsing event '#{show methodName}' failed: |]) ++) (parseEvent o) + (String "Function") -> modifyFailure ((unpack [lt|Parsing function '#{show methodName}' failed: |]) ++) (parseFunction o) + _ -> modifyFailure (const $ unpack [lt|Unexpected tag '#{show tag}' when parsing method '#{show methodName}'. Expecting "Event" or "Function".|]) empty) + where + parseEvent :: Object -> Parser Method + parseEvent o = + Event <$> + o .:? "methodAttributes" .!= [] <*> + o .: "methodName" <*> + methodInput + <* ensureNoMethodStreaming + where ensureNoMethodStreaming = if member "methodStreaming" o + then fail "Encountered Event with \"methodStreaming\" member. Events cannot have this member." + else pure () + methodInput = maybe BST.Void BST.Unary <$> (o .:? "methodInput") + + parseFunction :: Object -> Parser Method + parseFunction o = + Function <$> + o .:? "methodAttributes" .!= [] <*> + methodResult <*> + o .: "methodName" <*> + methodInput + where + streamingTag :: Parser MethodStreamingTag + streamingTag = o .:? "methodStreaming" .!= Unary + + methodInput :: Parser BST.MethodType + methodInput = do + i <- o .:? "methodInput" + st <- streamingTag + case (i, st) of + (Nothing, Unary) -> pure $ BST.Void + (Nothing, Client) -> fail $ invalidNothingComboMsg "input" Client + (Nothing, Server) -> pure $ BST.Void + (Nothing, Duplex) -> fail $ invalidNothingComboMsg "input" Duplex + (Just t, Unary) -> pure $ BST.Unary t + (Just t, Client) -> pure $ BST.Streaming t + (Just t, Server) -> pure $ BST.Unary t + (Just t, Duplex) -> pure $ BST.Streaming t + + methodResult :: Parser BST.MethodType + methodResult = do + r <- o .:? "methodResult" + st <- streamingTag + case (r, st) of + (Nothing, Unary) -> pure $ BST.Void + (Nothing, Client) -> pure $ BST.Void + (Nothing, Server) -> fail $ invalidNothingComboMsg "result" Server + (Nothing, Duplex) -> fail $ invalidNothingComboMsg "result" Duplex + (Just t, Unary) -> pure $ BST.Unary t + (Just t, Client) -> pure $ BST.Unary t + (Just t, Server) -> pure $ BST.Streaming t + (Just t, Duplex) -> pure $ BST.Streaming t + + invalidNothingComboMsg :: String -> MethodStreamingTag -> String + invalidNothingComboMsg dir streaming = unpack [lt|Method marked as #{show streaming}, but has void #{dir}|] + $(deriveJSON defaultOptions ''Modifier) $(deriveJSON defaultOptions ''Attribute) $(deriveJSON defaultOptions ''Constant) @@ -267,4 +365,3 @@ $(deriveJSON defaultOptions ''Declaration) $(deriveJSON defaultOptions ''Import) $(deriveJSON defaultOptions ''Language) -$(deriveJSON defaultOptions ''Method)
src/Language/Bond/Syntax/SchemaDef.hs view
@@ -200,12 +200,7 @@ resolve (BT_UserDefined a@Alias{} args) = resolve $ resolveAlias a args resolve t = t -- resolve value of an enum constant - resolveEnum Enum{..} n = fromIntegral . snd . fromJust $ find ((n ==) . fst) $ nameValues 0 enumConstants - where - -- fill in values for constants w/o explicitly specified value - nameValues _ [] = [] - nameValues _ ((Constant name (Just value)):xs) = (name, value) : nameValues (value + 1) xs - nameValues next ((Constant name Nothing):xs) = (name, next) : nameValues (next + 1) xs + resolveEnum Enum{..} n = fromIntegral . snd . fromJust $ find ((n ==) . fst) $ reifyEnumValues enumConstants resolveEnum _ _ = error "makeSchemaDef.resolveEnum: not a enum" $(deriveToJSON defaultOptions {omitNothingFields = True} ''SchemaDef)
src/Language/Bond/Syntax/Types.hs view
@@ -30,7 +30,9 @@ , Type(..) , TypeParam(..) , Constraint(..) - -- ** Comm + -- ** Services + , MethodType(..) + , methodTypeToMaybe , Method(..) -- ** Metadata , Attribute(..) @@ -121,21 +123,38 @@ } deriving (Eq, Show) +data MethodType = Void | Unary Type | Streaming Type + deriving (Eq, Show) + -- | Method of a service data Method = Function { methodAttributes :: [Attribute] -- zero or more attributes - , methodResult :: Maybe Type -- method result + , methodResult :: MethodType -- method result , methodName :: String -- method name - , methodInput :: Maybe Type -- method parameter + , methodInput :: MethodType -- method parameter } | Event { methodAttributes :: [Attribute] -- zero or more attributes , methodName :: String -- method name - , methodInput :: Maybe Type -- method parameter + , methodInput :: MethodType -- method parameter } deriving (Eq, Show) + +-- | Converts a MethodType into a Maybe Type to ease the transition from the +-- current definition of Method (which uses MethodType for input/results) +-- and the previous definition which used Maybe Type. +-- +-- This is intended to be used by codegen that doesn't yet support streaming +-- (e.g., C++ and Comm). Once that code has been updated to understand +-- streaming, this function will be removed. +-- +-- Raises an error if given a Streaming type. +methodTypeToMaybe :: MethodType -> Maybe Type +methodTypeToMaybe Void = Nothing +methodTypeToMaybe (Unary t) = Just t +methodTypeToMaybe (Streaming t) = error ("Unable to handle streaming " ++ (show t) ++ " in this codegen mode.") -- | Bond schema declaration data Declaration =
src/Language/Bond/Syntax/Util.hs view
@@ -36,6 +36,7 @@ , foldMapType -- * Helper functions , resolveAlias + , reifyEnumValues ) where import Data.Maybe @@ -231,3 +232,12 @@ paramsArgs = zip declParams args resolveAlias _ _ = error "resolveAlias: impossible happened." + + +-- | Fill in values for constants w/o explicitly specified value +reifyEnumValues :: [Constant] -> [(String, Int)] +reifyEnumValues constants = nameValues 0 constants + where + nameValues _ [] = [] + nameValues _ ((Constant name (Just value)):xs) = (name, value) : nameValues (value + 1) xs + nameValues next ((Constant name Nothing):xs) = (name, next) : nameValues (next + 1) xs
src/Language/Bond/Util.hs view
@@ -20,6 +20,7 @@ , sepEndBy , sepBeginBy , optional + , ifThenElse , angles , brackets , braces @@ -69,6 +70,11 @@ -- to the value inside 'Just' and returns the result. optional :: (Monoid m) => (a -> m) -> Maybe a -> m optional = maybe mempty + +-- if-then-else as a function +ifThenElse :: Bool -> a -> a -> a +ifThenElse True thenCondition _ = thenCondition +ifThenElse False _ elseCondition = elseCondition -- | If the 3rd argument is not 'mempty' the function wraps it between the -- first and second argument using 'mappend', otherwise it return 'mempty'.
tests/TestMain.hs view
@@ -5,6 +5,7 @@ import Test.Tasty.QuickCheck import Test.Tasty.HUnit (testCase) import Tests.Syntax +import Tests.Syntax.JSON(methodParsingTests) import Tests.Codegen import Tests.Codegen.Util(utilTestGroup) @@ -28,9 +29,11 @@ , testCase "simple service syntax" $ compareAST "service" , testCase "service attributes" $ compareAST "service_attributes" , testCase "generic service" $ compareAST "generic_service" + , testCase "streaming service" $ compareAST "streaming" , testCase "documentation example" $ compareAST "example" , testCase "service inheritance" $ compareAST "service_inheritance" ] + , methodParsingTests ] , testGroup "SchemaDef" [ verifySchemaDef "attributes" "Foo" @@ -79,6 +82,11 @@ ] "with_enum_header" , verifyCodegen + [ "c++" + , "--import-dir=tests/schema/imports" + ] + "import" + , verifyCodegen [ "c++" , "--allocator=arena" ] @@ -116,21 +124,17 @@ , "--export-attribute=DllExport" ] "service" - ] - , testGroup "Comm" - [ verifyCppCommCodegen - [ "c++" - ] - "service" - , verifyCppCommCodegen - [ "c++" - ] - "generic_service" - , verifyCppCommCodegen + , verifyExportsCodegen [ "c++" + , "--export-attribute=DllExport" ] - "service_attributes" + "with_enum_header" ] + , verifyCodegen + [ "c++" + , "--namespace=tests=nsmapped" + ] + "basic_types_nsmapped" , testGroup "Grpc" [ verifyCppGrpcCodegen [ "c++" @@ -157,25 +161,76 @@ , verifyCsCodegen "generics" , verifyCsCodegen "inheritance" , verifyCsCodegen "aliases" + , verifyCsCodegen "complex_inheritance" + , verifyCodegenVariation + [ "c#" + , "--preview-constructor-parameters" + , "--readonly-properties" + ] + "complex_inheritance" + "constructor-parameters" + , verifyCodegenVariation + [ "c#" + , "--preview-constructor-parameters" + , "--fields" + ] + "complex_inheritance" + "constructor-parameters_fields" , verifyCodegen [ "c#" , "--using=time=System.DateTime" ] "nullable_alias" - , testGroup "Comm" - [ verifyCsCommCodegen + , verifyCodegen + [ "c#" + , "--namespace=tests=nsmapped" + ] + "basic_types_nsmapped" + , verifyCodegen + [ "c#" + , "--import-dir=tests/schema/imports" + ] + "import" + , testGroup "Grpc" + [ verifyCsGrpcCodegen [ "c#" ] "service" - , verifyCsCommCodegen + , verifyCsGrpcCodegen [ "c#" ] "generic_service" - , verifyCsCommCodegen + , verifyCsGrpcCodegen [ "c#" ] "service_attributes" + , verifyCsGrpcCodegen + [ "c#" + ] + "streaming" ] + ] + , testGroup "Java" + [ verifyJavaCodegen "attributes" + , verifyJavaCodegen "basic_types" + , verifyJavaCodegen "bond_meta" + , verifyJavaCodegen "complex_types" + , verifyJavaCodegen "defaults" + , verifyJavaCodegen "empty" + , verifyJavaCodegen "field_modifiers" + , verifyJavaCodegen "generics" + , verifyJavaCodegen "inheritance" + , verifyJavaCodegen "aliases" + , verifyCodegen + [ "java" + , "--namespace=tests=nsmapped" + ] + "basic_types_nsmapped" + , verifyCodegen + [ "java" + , "--import-dir=tests/schema/imports" + ] + "import" ] ] ]
tests/Tests/Codegen.hs view
@@ -6,13 +6,14 @@ module Tests.Codegen ( verifyCodegen + , verifyCodegenVariation , verifyCppCodegen - , verifyCppCommCodegen , verifyCppGrpcCodegen , verifyApplyCodegen , verifyExportsCodegen , verifyCsCodegen - , verifyCsCommCodegen + , verifyCsGrpcCodegen + , verifyJavaCodegen ) where import System.FilePath @@ -22,13 +23,14 @@ import Prelude import Data.Algorithm.DiffContext import Data.Text.Lazy (Text, unpack) +import qualified Data.Text.Lazy as LT import qualified Data.ByteString.Char8 as BS import Text.PrettyPrint (render, text) import Test.Tasty import Test.Tasty.Golden.Advanced import Language.Bond.Codegen.Templates import Language.Bond.Codegen.TypeMapping -import Language.Bond.Syntax.Types (Bond(..), Import, Declaration) +import Language.Bond.Syntax.Types (Bond(..), Import, Declaration(..)) import Options import IO @@ -40,11 +42,19 @@ verifyCsCodegen :: FilePath -> TestTree verifyCsCodegen = verifyCodegen ["c#"] +verifyJavaCodegen :: FilePath -> TestTree +verifyJavaCodegen = verifyCodegen ["java"] + verifyCodegen :: [String] -> FilePath -> TestTree verifyCodegen args baseName = testGroup baseName $ - verifyFiles (processOptions args) baseName + verifyFiles (processOptions args) baseName "" +verifyCodegenVariation :: [String] -> FilePath -> FilePath -> TestTree +verifyCodegenVariation args baseName variation = + testGroup baseName $ + verifyFiles (processOptions args) baseName variation + verifyApplyCodegen :: [String] -> FilePath -> TestTree verifyApplyCodegen args baseName = testGroup baseName $ @@ -68,30 +78,18 @@ verifyExportsCodegen :: [String] -> FilePath -> TestTree verifyExportsCodegen args baseName = testGroup baseName $ - map (verifyFile options baseName cppTypeMapping "exports") templates - where - options = processOptions args - templates = - [ reflection_h (export_attribute options) - , comm_h (export_attribute options) - ] - -verifyCppCommCodegen :: [String] -> FilePath -> TestTree -verifyCppCommCodegen args baseName = - testGroup baseName $ - map (verifyFile options baseName cppTypeMapping "") templates + map (verifyFile options baseName (cppExpandAliases (type_aliases_enabled options) cppTypeMapping) "exports") (templates options) where options = processOptions args - templates = - [ comm_h (export_attribute options) - , comm_cpp - , types_cpp + templates Cpp {..} = + [ reflection_h export_attribute + , types_h export_attribute header enum_header allocator alloc_ctors_enabled type_aliases_enabled scoped_alloc_enabled ] verifyCppGrpcCodegen :: [String] -> FilePath -> TestTree verifyCppGrpcCodegen args baseName = testGroup baseName $ - map (verifyFile options baseName cppTypeMapping "") templates + map (verifyFile options baseName (cppExpandAliases (type_aliases_enabled options) cppTypeMapping) "") templates where options = processOptions args templates = @@ -100,15 +98,12 @@ , types_cpp ] -verifyCsCommCodegen :: [String] -> FilePath -> TestTree -verifyCsCommCodegen args baseName = +verifyCsGrpcCodegen :: [String] -> FilePath -> TestTree +verifyCsGrpcCodegen args baseName = testGroup baseName $ map (verifyFile (processOptions args) baseName csTypeMapping "") - [ comm_interface_cs - , comm_proxy_cs - , comm_service_cs - , grpc_cs - , types_cs Class (fieldMapping (processOptions args)) + [ grpc_cs + , types_cs Class (fieldMapping (processOptions args)) (constructorOptions (processOptions args)) ] where fieldMapping Cs {..} = if readonly_properties @@ -116,10 +111,13 @@ else if fields then PublicFields else Properties + constructorOptions Cs {..} = if constructor_parameters + then ConstructorParameters + else DefaultWithProtectedBase -verifyFiles :: Options -> FilePath -> [TestTree] -verifyFiles options baseName = - map (verify (typeMapping options) "") (templates options) +verifyFiles :: Options -> FilePath -> FilePath -> [TestTree] +verifyFiles options baseName variation = + map (verify (typeMapping options) variation) (templates options) <> extra options where @@ -129,28 +127,51 @@ else if fields then PublicFields else Properties - typeMapping Cpp {..} = maybe cppTypeMapping cppCustomAllocTypeMapping allocator + constructorOptions Cs {..} = if constructor_parameters + then ConstructorParameters + else DefaultWithProtectedBase + typeMapping Cpp {..} = cppExpandAliases type_aliases_enabled $ maybe cppTypeMapping (cppCustomAllocTypeMapping scoped_alloc_enabled) allocator typeMapping Cs {} = csTypeMapping + typeMapping Java {} = javaTypeMapping templates Cpp {..} = [ (reflection_h export_attribute) , types_cpp - , comm_cpp - , types_h header enum_header allocator + , types_h export_attribute header enum_header allocator alloc_ctors_enabled type_aliases_enabled scoped_alloc_enabled ] <> [ enum_h | enum_header] templates Cs {..} = - [ types_cs Class $ fieldMapping options + [ types_cs Class (fieldMapping options) (constructorOptions options) ] + templates Java {} = + [ javaCatTemplate + ] extra Cs {} = [ testGroup "collection interfaces" $ - map (verify csCollectionInterfacesTypeMapping "collection-interfaces") (templates options) + map (verify csCollectionInterfacesTypeMapping (variation </> "collection-interfaces")) (templates options) ] extra Cpp {..} = [ testGroup "custom allocator" $ - map (verify (cppCustomAllocTypeMapping "arena") "allocator") + map (verify (cppExpandAliasesTypeMapping $ cppCustomAllocTypeMapping False "arena") (variation </> "allocator")) (templates $ options { allocator = Just "arena" }) | isNothing allocator + ] ++ + [ testGroup "constructors with allocator argument" $ + map (verify (cppExpandAliasesTypeMapping $ cppCustomAllocTypeMapping False "arena") (variation </> "alloc_ctors")) + (templates $ options { allocator = Just "arena", alloc_ctors_enabled = True }) + | isNothing allocator + ] ++ + [ testGroup "type aliases" $ + map (verify (cppCustomAllocTypeMapping False "arena") (variation </> "type_aliases")) + (templates $ options { allocator = Just "arena", type_aliases_enabled = True }) + ] ++ + [ testGroup "scoped allocator" $ + map (verify (cppExpandAliasesTypeMapping $ cppCustomAllocTypeMapping True "arena") (variation </> "scoped_allocator")) + (templates $ options { allocator = Just "arena", scoped_alloc_enabled = True }) + | isNothing allocator ] + extra Java {} = + [ + ] verifyFile :: Options -> FilePath -> TypeMapping -> FilePath -> Template -> TestTree verifyFile options baseName typeMapping subfolder template = @@ -163,7 +184,7 @@ codegen = do aliasMapping <- parseAliasMappings $ using options namespaceMapping <- parseNamespaceMappings $ namespace options - (Bond imports namespaces declarations) <- parseBondFile [] $ "tests" </> "schema" </> baseName <.> "bond" + (Bond imports namespaces declarations) <- parseBondFile (import_dir options) $ "tests" </> "schema" </> baseName <.> "bond" let mappingContext = MappingContext typeMapping aliasMapping namespaceMapping namespaces let (_, code) = template mappingContext baseName imports declarations return $ BS.pack $ unpack code @@ -173,3 +194,19 @@ (text "test output") (text . BS.unpack) (getContextDiff 3 (BS.lines x) (BS.lines y)) + +javaCatTemplate :: MappingContext -> String -> [Import] -> [Declaration] -> (String, Text) +javaCatTemplate mappingContext _ imports declarations = + (suffix, LT.concat $ mapMaybe codegenDecl declarations) + where + suffix = "_concatenated.java" + codegenDecl declaration = + case declaration of + Struct {} -> Just $ class_java mappingContext imports declaration + Enum {} -> Just $ enum_java mappingContext declaration + _ -> Nothing + +cppExpandAliases :: Bool -> TypeMapping -> TypeMapping +cppExpandAliases type_aliases_enabled = if type_aliases_enabled + then id + else cppExpandAliasesTypeMapping
tests/Tests/Syntax.hs view
@@ -43,10 +43,19 @@ derive makeArbitrary ''Namespace derive makeArbitrary ''Type derive makeArbitrary ''TypeParam -derive makeArbitrary ''Method +derive makeArbitrary ''MethodType -roundtripAST :: Bond -> Bool -roundtripAST x = (decode . encode) x == Just x +instance Arbitrary Method where + arbitrary = oneof + [ Function <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + , Event <$> arbitrary <*> arbitrary <*> eventInput] + where + -- events cannot have streaming input, so we need to customize the + -- arbitrary input to omit Streaming + eventInput = oneof [return Void, Unary <$> arbitrary] + +roundtripAST :: Bond -> Property +roundtripAST x = (decode . encode) x === Just x assertException :: String -> IO a -> Assertion assertException errMsg action = do
+ tests/Tests/Syntax/JSON.hs view
@@ -0,0 +1,118 @@+-- Copyright (c) Microsoft. All rights reserved. +-- Licensed under the MIT license. See LICENSE file in the project root for full license information. + +{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} + +module Tests.Syntax.JSON + ( methodParsingTests + ) where + +import Data.Aeson (FromJSON, ToJSON, eitherDecode) +import Data.Aeson.Encode.Pretty (Config(..), encodePretty') +import Data.ByteString.Lazy (ByteString) +import Data.Maybe () +import Data.Text.Lazy as LT +import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8) +import Language.Bond.Syntax.JSON () +import Language.Bond.Syntax.Types (Declaration(..), Field(..), Method(..), MethodType(..), Modifier(..), Namespace(..), Type(..)) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (Assertion, (@=?), assertFailure, testCase) +import Text.Shakespeare.Text (lt) + +methodParsingTests :: TestTree +methodParsingTests = testGroup "Method JSON AST Parsing" + [ testCase "function without streaming tag: assumed Unary" funcWithoutStreamingTag_assumedUnary + , testCase "void function(AnyType) unary parses" $ assertJsonDecode (voidFunc Unary) (voidFuncAst "Unary") + , testCase "void function(AnyType) streaming Client parses" $ assertJsonDecode (voidFunc Streaming) (voidFuncAst "Client") + , testCase "void function(AnyType) streaming Server fails parsing" $ assertJsonDecodeFails (voidFuncAst "Server") methodDecode + , testCase "void function(AnyType) streaming Duplex fails parsing" $ assertJsonDecodeFails (voidFuncAst "Duplex") methodDecode + , testCase "nothing event(AnyType) with any methodStreaming fails parsing" $ assertJsonDecodeFails eventWithStreamingTag methodDecode ] + +funcWithoutStreamingTag_assumedUnary :: Assertion +funcWithoutStreamingTag_assumedUnary = assertJsonDecode expected ast + where + expected = Function + { methodAttributes = [] + , methodResult = Unary anyType + , methodName = "anyMethodName" + , methodInput = Unary anyType } + ast = [lt|{ +"tag": "Function", +"methodName": "anyMethodName", +"methodInput": #{anyTypeAst}, +"methodResult": #{anyTypeAst} +} +|] + +-- | Makes a 'Function' that returns void and has the given input type. +voidFunc :: (Type -> MethodType) -> Method +voidFunc streamingType = Function + { methodAttributes = [] + , methodResult = Void + , methodName = "anyMethodName" + , methodInput = (streamingType anyType) } + +-- | Makes the JSON AST for a function that returns void with the given +-- "methodStreaming" value. +voidFuncAst :: String -> LT.Text +voidFuncAst streamingTag = [lt|{ +"tag": "Function", +"methodName": "anyMethodName", +"methodInput": #{anyTypeAst}, +"methodStreaming": "#{streamingTag}" +} +|] + +-- | JSON AST of an event that (erroneously) includes a streaming tag. +eventWithStreamingTag :: Text +eventWithStreamingTag = [lt|{ +"tag": "Event", +"methodName": "anyMethodName", +"methodInput": #{anyTypeAst}, +"methodStreaming": "Unary" +} +|] + +-- | JSON AST decoder function for the 'Method' type +methodDecode :: ByteString -> Either String Method +methodDecode = eitherDecode + +-- | A placeholder user-defined type +anyType :: Type +anyType = BT_UserDefined + (Struct + { declNamespaces = [Namespace { nsLanguage = Nothing, nsName = ["any"] }] + , declAttributes = [] + , declName = "anyTypeName" + , declParams = [] + , structBase = Nothing + , structFields = [Field { fieldAttributes = [], fieldOrdinal = 0, fieldModifier = Optional, fieldType = BT_Int16, fieldName = "anyField", fieldDefault = Nothing }] }) + [] + +-- | The JSON AST representation of 'anyType' +anyTypeAst :: LT.Text +anyTypeAst = encodeText anyType + +-- | Helper method that JSON encodes to lazy text +encodeText :: ToJSON a => a -> LT.Text +encodeText o = decodeUtf8 (encodePretty' config o) + where config = (Config 2 compare) + +-- | Asserts that the given JSON decodes into the expected value +assertJsonDecode :: (Eq a, FromJSON a, Show a) => + a -- ^ The expected value + -> LT.Text -- ^ the JSON to decode + -> Assertion +assertJsonDecode expected json = case eitherDecode (encodeUtf8 json) of + Left parseError -> assertFailure ("JSON parse error: " ++ parseError ++ "\nInput JSON:\n" ++ (LT.unpack json)) + Right actual -> expected @=? actual + +-- | Asserts that attempting to decode the provided 'json' with the provided +-- 'decode' function fails. +assertJsonDecodeFails :: Show a => + LT.Text -- ^ the JSON to decode + -> (ByteString -> Either String a) -- ^ the decode function to run. Usually 'eitherDecode' for a specific type + -> Assertion +assertJsonDecodeFails json decode = case decode (encodeUtf8 json) of + Left _ -> return () + Right o -> assertFailure ("Expected JSON parsing to fail, but got '" ++ show o ++ "' instead.")