-- 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 #-} {-# OPTIONS_GHC -Wwarn #-} module Language.Bond.Codegen.Cpp.Util ( openNamespace , closeNamespace , className , classParams , qualifiedClassName , template , modifierTag , defaultValue , attributeInit , schemaMetadata , enumDefinition , isEnumDeclaration , enumValueToNameInitList , enumNameToValueInitList ) where import Data.Int (Int64) import Data.List (sortOn) import Data.Monoid import Prelude import Data.Text.Lazy (Text, unpack) import Data.Text.Lazy.Builder (toLazyText) import Text.Shakespeare.Text import Language.Bond.Syntax.Types import Language.Bond.Syntax.Util import Language.Bond.Util import Language.Bond.Codegen.Util import Language.Bond.Codegen.TypeMapping -- open namespaces openNamespace :: MappingContext -> Text openNamespace cpp = newlineSep 0 open $ getNamespace cpp where open n = [lt|namespace #{n} {|] -- close namespaces in reverse order closeNamespace :: MappingContext -> Text closeNamespace cpp = newlineSep 0 close (reverse $ getNamespace cpp) where close n = [lt|} // namespace #{n}|] className :: Declaration -> String className decl = declName decl <> classParams decl classParams :: Declaration -> String classParams = angles . sepBy ", " paramName . declParams qualifiedClassName :: MappingContext -> Declaration -> String qualifiedClassName cpp s@Struct {..} = qualifiedName <> classParams s where qualifiedName = unpack $ toLazyText $ getDeclTypeName cpp s qualifiedClassName _ _ = error "qualifiedClassName: impossible happened." template :: Declaration -> Text template d = if null $ declParams d then mempty else [lt|template |] where params = sepBy ", typename " paramName $ declParams d -- attribute initializer attributeInit :: [Attribute] -> Text attributeInit [] = "::bond::reflection::Attributes()" attributeInit xs = [lt|{ #{commaLineSep 5 attrNameValueText sortedAttributes} }|] where 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 modifierTag :: Field -> Text modifierTag Field {..} = [lt|::bond::reflection::#{modifier fieldType fieldModifier}_field_modifier|] where modifier BT_MetaName _ = [lt|required_optional|] modifier BT_MetaFullName _ = [lt|required_optional|] modifier _ RequiredOptional = [lt|required_optional|] modifier _ Required = [lt|required|] modifier _ _ = [lt|optional|] defaultValue :: MappingContext -> Type -> Default -> Text defaultValue _ BT_WString (DefaultString x) = [lt|L"#{x}"|] defaultValue _ BT_String (DefaultString x) = [lt|"#{x}"|] defaultValue _ BT_Float (DefaultFloat x) = [lt|#{x}f|] defaultValue _ BT_Int64 (DefaultInteger (-9223372036854775808)) = [lt|-9223372036854775807LL-1|] defaultValue _ BT_Int64 (DefaultInteger x) = [lt|#{x}LL|] defaultValue _ BT_UInt64 (DefaultInteger x) = [lt|#{x}ULL|] defaultValue _ BT_Int32 (DefaultInteger (-2147483648)) = [lt|-2147483647-1|] defaultValue m t (DefaultEnum x) = enumValue m t x defaultValue _ _ (DefaultBool True) = "true" defaultValue _ _ (DefaultBool False) = "false" defaultValue _ _ (DefaultInteger x) = [lt|#{x}|] defaultValue _ _ (DefaultFloat x) = [lt|#{x}|] defaultValue _ _ (DefaultNothing) = mempty defaultValue m (BT_UserDefined a@Alias {..} args) d = defaultValue m (resolveAlias a args) d defaultValue _ _ _ = error "defaultValue: impossible happened." enumValue :: ToText a => MappingContext -> Type -> a -> Text enumValue cpp (BT_UserDefined e@Enum {..} _) x = [lt|#{getQualifiedName cpp $ getDeclNamespace cpp e}::_bond_enumerators::#{declName}::#{x}|] enumValue cpp (BT_UserDefined a@Alias {..} args) e = enumValue cpp (resolveAlias a args) e enumValue _ _ _ = error "enumValue: impossible happened." -- schema metadata static member definitions schemaMetadata :: MappingContext -> Declaration -> Text schemaMetadata cpp s@Struct {..} = [lt| #{template s}const ::bond::Metadata #{className s}::Schema::metadata = #{className s}::Schema::GetMetadata();#{newlineBeginSep 1 staticDef structFields}|] where -- static member definition for field metadata staticDef f@Field {..} | fieldModifier == Optional && null fieldAttributes = [lt| #{template s}const ::bond::Metadata #{className s}::Schema::s_#{fieldName}_metadata = ::bond::reflection::MetadataInit(#{defaultInit f}"#{fieldName}");|] | otherwise = [lt| #{template s}const ::bond::Metadata #{className s}::Schema::s_#{fieldName}_metadata = ::bond::reflection::MetadataInit(#{defaultInit f}"#{fieldName}", #{modifierTag f}::value, #{attributeInit fieldAttributes});|] where defaultInit Field {fieldDefault = (Just def)} = [lt|#{explicitDefault def}, |] defaultInit _ = mempty explicitDefault (DefaultNothing) = "::bond::nothing" explicitDefault d@(DefaultInteger _) = staticCast d explicitDefault d@(DefaultFloat _) = staticCast d explicitDefault d = defaultValue cpp fieldType d staticCast d = [lt|static_cast<#{getTypeName cpp fieldType}>(#{defaultValue cpp fieldType d})|] schemaMetadata _ s@Service {..} = [lt| #{template s}const ::bond::Metadata #{className s}::Schema::metadata = ::bond::reflection::MetadataInit#{metadataInitArgs}("#{declName}", "#{idlNamespace}", #{attributeInit declAttributes});#{newlineBeginSep 1 staticDef serviceMethods}|] where idl = MappingContext idlTypeMapping [] [] [] idlNamespace = getDeclTypeName idl s metadataInitArgs = if null declParams then mempty else [lt||] -- static member definition for method metadata staticDef m = [lt| #{template s}const ::bond::Metadata #{className s}::Schema::s_#{methodName m}_metadata = ::bond::reflection::MetadataInit("#{methodName m}"#{attributes $ methodAttributes m}|] where attributes [] = [lt|);|] attributes a = [lt|, #{attributeInit a});|] schemaMetadata _ _ = error "schemaMetadata: impossible happened." enumDefinition :: Declaration -> Text enumDefinition Enum {..} = [lt|enum #{declName} { #{commaLineSep 3 constant enumConstants} };|] where constant Constant {..} = [lt|#{constantName}#{optional value constantValue}|] value (-2147483648) = [lt| = static_cast(-2147483647-1)|] value x = [lt| = static_cast(#{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."