Merge branch 'qnikst-warning-cleanup'
This commit is contained in:
Adam Sapek
Коммит
a852f6a36b
|
|
@ -15,7 +15,6 @@ import Data.List
|
|||
import Data.Function
|
||||
import Control.Applicative
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans (liftIO)
|
||||
import Text.Parsec.Pos (initialPos)
|
||||
import Text.Parsec hiding (many, optional, (<|>))
|
||||
import Bond.Lexer
|
||||
|
|
@ -42,6 +41,8 @@ newEnvironment = Environment [] []
|
|||
|
||||
type Parser a = ParsecT String Symbols (ReaderT Environment IO) a
|
||||
|
||||
parseBond :: SourceName
|
||||
-> String -> ReaderT Environment IO (Either ParseError Bond)
|
||||
parseBond = runParserT bond $ Symbols [] []
|
||||
|
||||
data Bond = Bond [Import] [Namespace] [Declaration]
|
||||
|
|
@ -88,6 +89,7 @@ declaration = do
|
|||
updateSymbols decl <?> "declaration"
|
||||
return decl
|
||||
|
||||
updateSymbols :: Declaration -> Parser ()
|
||||
updateSymbols decl = do
|
||||
(previous, symbols) <- partition (duplicateDeclaration decl) <$> symbols <$> getState
|
||||
case reconcile previous decl of
|
||||
|
|
@ -103,6 +105,7 @@ updateSymbols decl = do
|
|||
-- imports multiple times but that would have to depend on canonical file
|
||||
-- paths which are unreliable.
|
||||
reconcile [x] y = (x == y, const id)
|
||||
reconcile _ _ = error "updateSymbols/reconcile: impossible happened."
|
||||
paramsMatch = (==) `on` (map paramConstraint . declParams)
|
||||
add x xs u = u { symbols = x:xs }
|
||||
|
||||
|
|
@ -118,9 +121,9 @@ findSymbol name = doFind <?> "qualified name"
|
|||
delcMatching namespaces [unqualifiedName] decl =
|
||||
unqualifiedName == declName decl
|
||||
&& (not $ null $ intersectBy nsMatching namespaces (declNamespaces decl))
|
||||
delcMatching _ qualifiedName decl =
|
||||
takeName qualifiedName == declName decl
|
||||
&& any ((takeNamespace qualifiedName ==) . nsName) (declNamespaces decl)
|
||||
delcMatching _ qualifiedName' decl =
|
||||
takeName qualifiedName' == declName decl
|
||||
&& any ((takeNamespace qualifiedName' ==) . nsName) (declNamespaces decl)
|
||||
nsMatching ns1 ns2 =
|
||||
nsName ns1 == nsName ns2 && (lang1 == lang2 || lang1 == Nothing || lang2 == Nothing)
|
||||
where
|
||||
|
|
@ -131,10 +134,10 @@ findStruct :: QualifiedName -> Parser Declaration
|
|||
findStruct name = doFind <?> "qualified struct name"
|
||||
where
|
||||
doFind = do
|
||||
symbol <- findSymbol name
|
||||
case symbol of
|
||||
Struct {..} -> return symbol
|
||||
_ -> fail $ "The " ++ show symbol ++ " is invalid in this context. Expected a struct."
|
||||
symb <- findSymbol name
|
||||
case symb of
|
||||
Struct {..} -> return symb
|
||||
_ -> fail $ "The " ++ show symb ++ " is invalid in this context. Expected a struct."
|
||||
|
||||
-- namespace
|
||||
namespace :: Parser Namespace
|
||||
|
|
@ -189,6 +192,7 @@ view = do
|
|||
Struct namespaces attr name (declParams decl) (structBase decl) (viewFields decl fields) <$ optional semi
|
||||
where
|
||||
viewFields Struct {..} fields = filter ((`elem` fields) . fieldName) structFields
|
||||
viewFields _ _ = error "view/viewFields: impossible happened."
|
||||
|
||||
-- struct definition parser
|
||||
struct :: Parser Declaration
|
||||
|
|
@ -204,14 +208,17 @@ struct = do
|
|||
fields = unique $ braces $ manySortedBy (comparing fieldOrdinal) (field <* semi)
|
||||
with params e = e { currentParams = params }
|
||||
unique p = do
|
||||
fields <- p
|
||||
case findDuplicates fields of
|
||||
[] -> return fields
|
||||
fields' <- p
|
||||
case findDuplicates fields' of
|
||||
[] -> return fields'
|
||||
Field {..}:_ -> fail $ "Duplicate definition of the field with ordinal " ++ show fieldOrdinal
|
||||
where
|
||||
findDuplicates xs = deleteFirstsBy ordinal xs (nubBy ordinal xs)
|
||||
ordinal = (==) `on` fieldOrdinal
|
||||
|
||||
manySortedBy :: (a -> a -> Ordering)
|
||||
-> ParsecT s u m a
|
||||
-> ParsecT s u m [a]
|
||||
manySortedBy = manyAccum . insertBy
|
||||
|
||||
-- field definition parser
|
||||
|
|
@ -237,8 +244,8 @@ enum :: Parser Declaration
|
|||
enum = Enum <$> asks currentNamespaces <*> attributes <*> name <*> consts <* optional semi <?> "enum definition"
|
||||
where
|
||||
name = keyword "enum" *> (identifier <?> "enum identifier")
|
||||
consts = braces (semiOrCommaSepEnd1 const <?> "enum constant")
|
||||
const = Constant <$> identifier <*> optional value
|
||||
consts = braces (semiOrCommaSepEnd1 constant <?> "enum constant")
|
||||
constant = Constant <$> identifier <*> optional value
|
||||
value = equal *> (fromIntegral <$> integer)
|
||||
|
||||
-- basic types parser
|
||||
|
|
@ -276,6 +283,7 @@ basicUserType = do
|
|||
BT_WString -> True
|
||||
_ -> scalarType t
|
||||
typeName (BT_UserDefined decl _) = declName decl
|
||||
typeName _ = error "basicUserType/typeName: impossible happened."
|
||||
|
||||
-- containers parser
|
||||
complexType :: Parser Type
|
||||
|
|
@ -298,14 +306,14 @@ userType = do
|
|||
Nothing -> do
|
||||
decl <- findSymbol name
|
||||
args <- option [] (angles $ commaSep1 arg)
|
||||
if length args /= length (params decl)
|
||||
if length args /= length (params' decl)
|
||||
then
|
||||
fail $ declName decl ++ " requires " ++ (show.length $ declParams decl) ++ " type argument(s)"
|
||||
else
|
||||
return $ BT_UserDefined decl args
|
||||
where
|
||||
params Enum{..} = []
|
||||
params d = declParams d
|
||||
params' Enum{..} = []
|
||||
params' d = declParams d
|
||||
arg = type_ <|> BT_IntTypeArg <$> (fromIntegral <$> integer)
|
||||
where
|
||||
isParam [name] TypeParam {..} = name == paramName
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ module Bond.Schema
|
|||
, Language(..)
|
||||
, Namespace(..)
|
||||
, Attribute(..)
|
||||
, QualifiedName(..)
|
||||
, QualifiedName
|
||||
, takeName
|
||||
, takeNamespace
|
||||
, showQualifiedName
|
||||
|
|
@ -43,9 +43,6 @@ import Data.Word
|
|||
import Data.List
|
||||
import Data.Foldable (foldMap)
|
||||
import Data.Monoid
|
||||
import System.FilePath
|
||||
import Data.Text.Lazy.Builder
|
||||
import Text.Shakespeare.Text
|
||||
import Bond.Util
|
||||
|
||||
type QualifiedName = [String]
|
||||
|
|
@ -81,6 +78,7 @@ data Type =
|
|||
BT_UserDefined Declaration [Type]
|
||||
deriving Eq
|
||||
|
||||
scalarType :: Type -> Bool
|
||||
scalarType BT_Int8 = True
|
||||
scalarType BT_Int16 = True
|
||||
scalarType BT_Int32 = True
|
||||
|
|
@ -96,31 +94,39 @@ scalarType (BT_TypeParam (TypeParam _ (Just Value))) = True
|
|||
scalarType (BT_UserDefined Enum {..} _) = True
|
||||
scalarType _ = False
|
||||
|
||||
metaType :: Type -> Bool
|
||||
metaType BT_MetaName = True
|
||||
metaType BT_MetaFullName = True
|
||||
metaType _ = False
|
||||
|
||||
stringType :: Type -> Bool
|
||||
stringType BT_String = True
|
||||
stringType BT_WString = True
|
||||
stringType _ = False
|
||||
|
||||
listType :: Type -> Bool
|
||||
listType (BT_List _) = True
|
||||
listType (BT_Vector _) = True
|
||||
listType _ = False
|
||||
|
||||
associativeType :: Type -> Bool
|
||||
associativeType (BT_Set _) = True
|
||||
associativeType (BT_Map _ _) = True
|
||||
associativeType _ = False
|
||||
|
||||
containerType :: Type -> Bool
|
||||
containerType f = listType f || associativeType f
|
||||
|
||||
structType :: Type -> Bool
|
||||
structType (BT_UserDefined Struct {} _) = True
|
||||
structType (BT_UserDefined a@Alias {} args) = structType $ resolveAlias a args
|
||||
structType _ = False
|
||||
|
||||
nullableType :: Type -> Bool
|
||||
nullableType (BT_Nullable _) = True
|
||||
nullableType _ = False
|
||||
|
||||
metaField :: Field -> Any
|
||||
metaField Field {..} = Any $ metaType fieldType
|
||||
|
||||
data Default =
|
||||
|
|
@ -150,6 +156,13 @@ data Field =
|
|||
}
|
||||
deriving Eq
|
||||
|
||||
makeField :: [Attribute]
|
||||
-> Word16
|
||||
-> Modifier
|
||||
-> Type
|
||||
-> String
|
||||
-> Maybe Default
|
||||
-> Field
|
||||
makeField a o m t n d@(Just DefaultNothing) = Field a o m (BT_Maybe t) n d
|
||||
makeField a o m t n d = Field a o m t n d
|
||||
|
||||
|
|
@ -206,6 +219,7 @@ data Declaration =
|
|||
}
|
||||
deriving Eq
|
||||
|
||||
showTypeParams :: [TypeParam] -> String
|
||||
showTypeParams = angles . sepBy ", " show
|
||||
|
||||
instance Show Declaration where
|
||||
|
|
@ -226,14 +240,16 @@ mapType f x = f x
|
|||
|
||||
foldMapFields :: (Monoid m) => (Field -> m) -> Type -> m
|
||||
foldMapFields f t = case t of
|
||||
(BT_UserDefined s@Struct {..} _) -> optional (foldMapFields f) structBase <> foldMap f structFields
|
||||
(BT_UserDefined Struct {..} _) -> optional (foldMapFields f) structBase <> foldMap f structFields
|
||||
(BT_UserDefined a@Alias {..} args) -> foldMapFields f $ resolveAlias a args
|
||||
_ -> mempty
|
||||
|
||||
foldMapStructFields :: Monoid m
|
||||
=> (Field -> m) -> Declaration -> m
|
||||
foldMapStructFields f s = foldMapFields f $ BT_UserDefined s []
|
||||
|
||||
foldMapType :: (Monoid m) => (Type -> m) -> Type -> m
|
||||
foldMapType f t@(BT_UserDefined decl args) = f t <> foldMap (foldMapType f) args
|
||||
foldMapType f t@(BT_UserDefined _decl args) = f t <> foldMap (foldMapType f) args
|
||||
foldMapType f t@(BT_Map key value) = f t <> foldMapType f key <> foldMapType f value
|
||||
foldMapType f t@(BT_List element) = f t <> foldMapType f element
|
||||
foldMapType f t@(BT_Vector element) = f t <> foldMapType f element
|
||||
|
|
@ -249,6 +265,7 @@ resolveAlias Alias {..} args = mapType resolveParam $ resolveParam aliasType
|
|||
resolveParam (BT_TypeParam param) = snd.fromJust $ find ((param ==).fst) paramsArgs
|
||||
resolveParam x = x
|
||||
paramsArgs = zip declParams args
|
||||
resolveAlias _ _ = error "resolveAlias: impossible happened."
|
||||
|
||||
duplicateDeclaration :: Declaration -> Declaration -> Bool
|
||||
duplicateDeclaration left right =
|
||||
|
|
|
|||
|
|
@ -5,16 +5,17 @@
|
|||
|
||||
module Bond.Template.Cpp.Apply_cpp (apply_cpp) where
|
||||
|
||||
import System.FilePath
|
||||
import Data.Monoid
|
||||
import Data.Text.Lazy (Text)
|
||||
import Text.Shakespeare.Text
|
||||
import Bond.Schema
|
||||
import Bond.Template.TypeMapping
|
||||
import Bond.Template.Util
|
||||
import Bond.Template.Cpp.Apply_h
|
||||
import qualified Bond.Template.Cpp.Util as CPP
|
||||
|
||||
-- generate the *_apply.cpp file from parsed .bond file
|
||||
apply_cpp protocols cpp file imports declarations = ("_apply.cpp", [lt|
|
||||
apply_cpp :: [Protocol] -> MappingContext -> String -> [Import] -> [Declaration] -> (String, Text)
|
||||
apply_cpp protocols cpp file _imports declarations = ("_apply.cpp", [lt|
|
||||
#include "#{file}_apply.h"
|
||||
#include "#{file}_reflection.h"
|
||||
|
||||
|
|
|
|||
|
|
@ -7,10 +7,12 @@ module Bond.Template.Cpp.Apply_h (apply_h, Protocol(..), apply) where
|
|||
|
||||
import System.FilePath
|
||||
import Data.Monoid
|
||||
import Data.Text.Lazy (Text)
|
||||
import Text.Shakespeare.Text
|
||||
import Bond.Schema
|
||||
import Bond.Util
|
||||
import Bond.Template.Util
|
||||
import Bond.Template.TypeMapping
|
||||
import qualified Bond.Template.Cpp.Util as CPP
|
||||
|
||||
data Protocol =
|
||||
|
|
@ -20,6 +22,7 @@ data Protocol =
|
|||
}
|
||||
|
||||
-- generate the *_apply.h file from parsed .bond file
|
||||
apply_h :: [Protocol] -> Maybe String -> MappingContext -> String -> [Import] -> [Declaration] -> (String, Text)
|
||||
apply_h protocols attribute cpp file imports declarations = ("_apply.h", [lt|
|
||||
#pragma once
|
||||
|
||||
|
|
@ -41,6 +44,7 @@ apply_h protocols attribute cpp file imports declarations = ("_apply.h", [lt|
|
|||
semi = [lt|;|]
|
||||
|
||||
-- Apply overloads
|
||||
apply :: [Protocol] -> Text -> Text -> Declaration -> Text
|
||||
apply protocols attr body Struct {..} | null declParams = [lt|
|
||||
//
|
||||
// Overloads of Apply function with common transforms for #{declName}.
|
||||
|
|
@ -76,8 +80,8 @@ apply protocols attr body Struct {..} | null declParams = [lt|
|
|||
const bond::bonded<#{declName}>& value)#{body}
|
||||
#{newlineSep 1 (transcoding transform) protocols}|]
|
||||
where
|
||||
transcoding transform Protocol {protocolReader = fromReader} = [lt|
|
||||
#{attr}bool Apply(const bond::#{transform}<bond::#{protocolWriter}<bond::OutputBuffer> >& transform,
|
||||
transcoding transform' Protocol {protocolReader = fromReader} = [lt|
|
||||
#{attr}bool Apply(const bond::#{transform'}<bond::#{protocolWriter}<bond::OutputBuffer> >& transform,
|
||||
const bond::bonded<#{declName}, bond::#{fromReader}<bond::InputBuffer>&>& value)#{body}|]
|
||||
|
||||
apply _ _ _ _ = mempty
|
||||
|
|
|
|||
|
|
@ -5,8 +5,8 @@
|
|||
|
||||
module Bond.Template.Cpp.Enum_h (enum_h) where
|
||||
|
||||
import System.FilePath
|
||||
import Data.Monoid
|
||||
import Data.Text.Lazy (Text)
|
||||
import Text.Shakespeare.Text
|
||||
import Bond.Schema
|
||||
import Bond.Template.TypeMapping
|
||||
|
|
@ -14,7 +14,8 @@ import Bond.Template.Util
|
|||
import qualified Bond.Template.Cpp.Util as CPP
|
||||
|
||||
-- generate the *_types.h file from parsed .bond file
|
||||
enum_h cpp file imports declarations = ("_enum.h", [lt|
|
||||
enum_h :: MappingContext -> String -> [Import] -> [Declaration] -> (String, Text)
|
||||
enum_h cpp _file _imports declarations = ("_enum.h", [lt|
|
||||
#pragma once
|
||||
|
||||
#{CPP.openNamespace cpp}
|
||||
|
|
|
|||
|
|
@ -7,6 +7,7 @@ module Bond.Template.Cpp.Reflection_h (reflection_h) where
|
|||
|
||||
import System.FilePath
|
||||
import Data.Monoid
|
||||
import Data.Text.Lazy (Text)
|
||||
import Text.Shakespeare.Text
|
||||
import Bond.Schema
|
||||
import Bond.Template.TypeMapping
|
||||
|
|
@ -14,6 +15,7 @@ import Bond.Template.Util
|
|||
import qualified Bond.Template.Cpp.Util as CPP
|
||||
|
||||
-- generate the *_refection.h file from parsed .bond file
|
||||
reflection_h :: MappingContext -> String -> [Import] -> [Declaration] -> (String, Text)
|
||||
reflection_h cpp file imports declarations = ("_reflection.h", [lt|
|
||||
#pragma once
|
||||
|
||||
|
|
|
|||
|
|
@ -6,6 +6,7 @@
|
|||
module Bond.Template.Cpp.Types_cpp (types_cpp) where
|
||||
|
||||
import Data.Monoid
|
||||
import Data.Text.Lazy (Text)
|
||||
import Text.Shakespeare.Text
|
||||
import Bond.Schema
|
||||
import Bond.Template.TypeMapping
|
||||
|
|
@ -13,7 +14,8 @@ import Bond.Template.Util
|
|||
import qualified Bond.Template.Cpp.Util as CPP
|
||||
|
||||
-- generate the *_types_cpp file from parsed .bond file
|
||||
types_cpp cpp file imports declarations = ("_types.cpp", [lt|
|
||||
types_cpp :: MappingContext -> String -> [Import] -> [Declaration] -> (String, Text)
|
||||
types_cpp cpp file _imports declarations = ("_types.cpp", [lt|
|
||||
#include "#{file}_reflection.h"
|
||||
#include <bond/core/exception.h>
|
||||
|
||||
|
|
@ -27,7 +29,7 @@ types_cpp cpp file imports declarations = ("_types.cpp", [lt|
|
|||
if null declParams then CPP.schemaMetadata cpp s else mempty
|
||||
|
||||
-- global variables for enum name/value conversions
|
||||
statics e@Enum {..} = [lt|
|
||||
statics Enum {..} = [lt|
|
||||
namespace _bond_enumerators
|
||||
{
|
||||
namespace #{declName}
|
||||
|
|
|
|||
|
|
@ -21,6 +21,10 @@ import Bond.Template.Util
|
|||
import qualified Bond.Template.Cpp.Util as CPP
|
||||
|
||||
-- generate the *_types.h file from parsed .bond file
|
||||
types_h :: [String]
|
||||
-> Bool
|
||||
-> Maybe String
|
||||
-> MappingContext -> String -> [Import] -> [Declaration] -> (String, L.Text)
|
||||
types_h userHeaders enumHeader allocator cpp file imports declarations = ("_types.h", [lt|
|
||||
#pragma once
|
||||
#{newlineBeginSep 0 includeHeader userHeaders}
|
||||
|
|
@ -181,7 +185,7 @@ namespace std
|
|||
| otherwise = Nothing
|
||||
|
||||
-- constructor initializer list from 'base' and 'fields' initializers
|
||||
initializeList base fields = between colon mempty $ commaLineSep 3 id [base, fields]
|
||||
initializeList base' fields = between colon mempty $ commaLineSep 3 id [base', fields]
|
||||
where
|
||||
colon = [lt|
|
||||
: |]
|
||||
|
|
@ -237,6 +241,7 @@ namespace std
|
|||
allocInitValue i f d = i f d
|
||||
keyType (BT_Set key) = cppType key
|
||||
keyType (BT_Map key _) = cppType key
|
||||
keyType _ = error "allocatorCtor/keyType: impossible happened."
|
||||
allocParameterized = L.isInfixOf (L.pack alloc) . toLazyText . cppType
|
||||
|
||||
-- copy constructor
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
-- Licensed under the MIT license. See LICENSE file in the project root for full license information.
|
||||
|
||||
{-# LANGUAGE QuasiQuotes, OverloadedStrings, RecordWildCards #-}
|
||||
{-# OPTIONS_GHC -Wwarn #-}
|
||||
|
||||
module Bond.Template.Cpp.Util
|
||||
( openNamespace
|
||||
|
|
@ -21,32 +22,41 @@ module Bond.Template.Cpp.Util
|
|||
|
||||
import Text.Shakespeare.Text
|
||||
import Data.Monoid
|
||||
import Data.Text.Lazy (Text)
|
||||
import Bond.Schema
|
||||
import Bond.Util
|
||||
import Bond.Template.Util
|
||||
import Bond.Template.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}|]
|
||||
|
||||
structName :: Declaration -> String
|
||||
structName s@Struct {..} = declName <> structParams s
|
||||
structName _ = error "structName: impossible happened."
|
||||
|
||||
structParams :: Declaration -> String
|
||||
structParams Struct {..} = angles $ sepBy ", " paramName declParams
|
||||
structParams _ = error "structName: impossible happened."
|
||||
|
||||
template :: Declaration -> Text
|
||||
template d = if null $ declParams d then mempty else [lt|template <typename #{params}>
|
||||
|]
|
||||
where
|
||||
params = sepBy ", typename " paramName $ declParams d
|
||||
|
||||
-- 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}|]
|
||||
where
|
||||
|
|
@ -54,6 +64,7 @@ attributeInit xs = [lt|boost::assign::map_list_of<std::string, std::string>#{new
|
|||
|
||||
|
||||
-- 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|]
|
||||
|
|
@ -62,6 +73,7 @@ modifierTag Field {..} = [lt|bond::reflection::#{modifier fieldType fieldModifie
|
|||
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|]
|
||||
|
|
@ -75,11 +87,15 @@ defaultValue _ _ (DefaultBool False) = "false"
|
|||
defaultValue _ _ (DefaultInteger x) = [lt|#{x}|]
|
||||
defaultValue _ _ (DefaultFloat x) = [lt|#{x}|]
|
||||
defaultValue _ _ (DefaultNothing) = mempty
|
||||
defaultValue _ _ _ = error "defaultValue: impossible happened."
|
||||
|
||||
enumValue :: ToText a => MappingContext -> Type -> a -> Text
|
||||
enumValue cpp (BT_UserDefined e@Enum {..} _) x =
|
||||
[lt|#{getGlobalQualifiedName cppTypeMapping $ getDeclNamespace cpp e}::_bond_enumerators::#{declName}::#{x}|]
|
||||
enumValue _ _ _ = error "enumValue: impossible happened."
|
||||
|
||||
-- schema metadata static member definitions
|
||||
schemaMetadata :: MappingContext -> Declaration -> Text
|
||||
schemaMetadata cpp s@Struct {..} = [lt|
|
||||
#{template s}const bond::Metadata #{structName s}::Schema::metadata
|
||||
= #{structName s}::Schema::GetMetadata();#{newlineBeginSep 1 staticDef structFields}|]
|
||||
|
|
@ -101,14 +117,18 @@ schemaMetadata cpp s@Struct {..} = [lt|
|
|||
explicitDefault d@(DefaultFloat _) = staticCast d
|
||||
explicitDefault d = defaultValue cpp fieldType d
|
||||
staticCast d = [lt|static_cast<#{getTypeName cpp fieldType}>(#{defaultValue cpp fieldType d})|]
|
||||
schemaMetadata _ _ = error "schemaMetadata: impossible happened."
|
||||
|
||||
defaultedFunctions, rvalueReferences :: Text
|
||||
defaultedFunctions = [lt|BOND_NO_CXX11_DEFAULTED_FUNCTIONS|]
|
||||
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}
|
||||
{
|
||||
#{commaLineSep 3 constant enumConstants}
|
||||
|
|
@ -116,4 +136,5 @@ enumDefinition Enum {..} = [lt|enum #{declName}
|
|||
where
|
||||
constant Constant {..} = [lt|#{constantName}#{optional value constantValue}|]
|
||||
value x = [lt| = #{x}|]
|
||||
enumDefinition _ = error "enumDefinition: impossible happened."
|
||||
|
||||
|
|
|
|||
|
|
@ -5,9 +5,9 @@
|
|||
|
||||
module Bond.Template.Cs.Types_cs (types_cs) where
|
||||
|
||||
import System.FilePath
|
||||
import Data.Monoid
|
||||
import Data.Foldable (foldMap)
|
||||
import Data.Text.Lazy (Text)
|
||||
import Text.Shakespeare.Text
|
||||
import Bond.Schema
|
||||
import Bond.Util
|
||||
|
|
@ -16,7 +16,8 @@ import Bond.Template.Util
|
|||
import qualified Bond.Template.Cs.Util as CS
|
||||
|
||||
-- generate the *_types.cs file from parsed .bond file
|
||||
types_cs readOnly useFields cs file imports declarations = ("_types.cs", [lt|
|
||||
types_cs :: Bool -> Bool -> MappingContext -> String -> [Import] -> [Declaration] -> (String, Text)
|
||||
types_cs readOnly useFields cs _file _imports declarations = ("_types.cs", [lt|
|
||||
#{CS.disableReSharperWarnings}
|
||||
namespace #{csNamespace}
|
||||
{
|
||||
|
|
|
|||
|
|
@ -12,13 +12,16 @@ module Bond.Template.Cs.Util
|
|||
, disableReSharperWarnings
|
||||
) where
|
||||
|
||||
import Data.Int (Int64)
|
||||
import Data.Monoid
|
||||
import Data.Text.Lazy (Text)
|
||||
import Text.Shakespeare.Text
|
||||
import Bond.Version
|
||||
import Bond.Schema
|
||||
import Bond.Template.TypeMapping
|
||||
import Bond.Template.Util
|
||||
|
||||
disableReSharperWarnings :: Text
|
||||
disableReSharperWarnings = [lt|
|
||||
#region ReSharper warnings
|
||||
// ReSharper disable PartialTypeWithSinglePart
|
||||
|
|
@ -31,6 +34,7 @@ disableReSharperWarnings = [lt|
|
|||
|]
|
||||
|
||||
-- C# field/property attributes
|
||||
propertyAttributes :: MappingContext -> Field -> Text
|
||||
propertyAttributes cs Field {..} =
|
||||
schemaAttributes 2 fieldAttributes
|
||||
<> [lt|[global::Bond.Id(#{fieldOrdinal})#{typeAttribute}#{modifierAttribute fieldType fieldModifier}]|]
|
||||
|
|
@ -48,6 +52,7 @@ propertyAttributes cs Field {..} =
|
|||
modifierAttribute _ _ = mempty
|
||||
|
||||
-- C# class/struct/interface attributes
|
||||
typeAttributes :: MappingContext -> Declaration -> Text
|
||||
typeAttributes cs s@Struct {..} =
|
||||
optionalTypeAttributes cs s
|
||||
<> [lt|[global::Bond.Schema]
|
||||
|
|
@ -58,9 +63,12 @@ typeAttributes cs s@Struct {..} =
|
|||
typeAttributes cs e@Enum {..} =
|
||||
optionalTypeAttributes cs e
|
||||
<> generatedCodeAttr
|
||||
typeAttributes _ _ = error "typeAttributes: impossible happened."
|
||||
|
||||
generatedCodeAttr :: Text
|
||||
generatedCodeAttr = [lt|[System.CodeDom.Compiler.GeneratedCode("gbc", "#{majorVersion}.#{minorVersion}")]|]
|
||||
|
||||
optionalTypeAttributes :: MappingContext -> Declaration -> Text
|
||||
optionalTypeAttributes cs decl =
|
||||
schemaAttributes 1 (declAttributes decl)
|
||||
<> namespaceAttribute
|
||||
|
|
@ -71,18 +79,21 @@ optionalTypeAttributes cs decl =
|
|||
|]
|
||||
|
||||
-- Attributes defined by the user in the schema
|
||||
schemaAttributes :: Int64 -> [Attribute] -> Text
|
||||
schemaAttributes indent = newlineSepEnd indent schemaAttribute
|
||||
where
|
||||
schemaAttribute Attribute {..} =
|
||||
[lt|[global::Bond.Attribute("#{getIdlQualifiedName attrName}", "#{attrValue}")]|]
|
||||
|
||||
-- generic type parameter constraints
|
||||
paramConstraints :: [TypeParam] -> Text
|
||||
paramConstraints = newlineBeginSep 2 constraint
|
||||
where
|
||||
constraint (TypeParam _ Nothing) = mempty
|
||||
constraint (TypeParam name (Just Value)) = [lt|where #{name} : struct|]
|
||||
|
||||
-- Initial value for C# field/property or Nothing if C# implicit default is OK
|
||||
defaultValue :: MappingContext -> Field -> Maybe Text
|
||||
defaultValue cs Field {fieldDefault = Nothing, ..} = implicitDefault fieldType
|
||||
where
|
||||
newInstance t = Just [lt|new #{getInstanceTypeName cs t}()|]
|
||||
|
|
@ -107,8 +118,9 @@ defaultValue cs Field {fieldDefault = (Just def), ..} = explicitDefault def
|
|||
explicitDefault (DefaultInteger x) = Just [lt|#{x}|]
|
||||
explicitDefault (DefaultFloat x) = Just $ floatLiteral fieldType x
|
||||
where
|
||||
floatLiteral BT_Float x = [lt|#{x}F|]
|
||||
floatLiteral BT_Double x = [lt|#{x}|]
|
||||
floatLiteral BT_Float y = [lt|#{y}F|]
|
||||
floatLiteral BT_Double y = [lt|#{y}|]
|
||||
floatLiteral _ _ = error "defaultValue/floatLiteral: impossible happened."
|
||||
explicitDefault (DefaultBool True) = Just "true"
|
||||
explicitDefault (DefaultBool False) = Just "false"
|
||||
explicitDefault (DefaultString x) = Just [lt|"#{x}"|]
|
||||
|
|
|
|||
|
|
@ -4,8 +4,8 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Bond.Template.CustomMapping
|
||||
( parseAliasMapping
|
||||
, parseNamespaceMapping
|
||||
( parseAliasMappings
|
||||
, parseNamespaceMappings
|
||||
, AliasMapping(..)
|
||||
, Fragment(..)
|
||||
, NamespaceMapping(..)
|
||||
|
|
@ -30,19 +30,26 @@ data NamespaceMapping = NamespaceMapping
|
|||
, toNamespace :: QualifiedName
|
||||
}
|
||||
|
||||
|
||||
whitespace :: Parsec SourceName u String
|
||||
whitespace = many (char ' ') <?> "whitespace"
|
||||
identifier :: Parsec SourceName u String
|
||||
identifier = many1 (alphaNum <|> char '_') <?> "identifier"
|
||||
qualifiedName :: Parsec SourceName u [String]
|
||||
qualifiedName = sepBy1 identifier (char '.') <?> "qualified name"
|
||||
symbol :: String -> Parsec SourceName u String
|
||||
symbol s = whitespace *> string s <* whitespace
|
||||
equal :: Parsec SourceName u String
|
||||
equal = symbol "="
|
||||
integer :: Parsec SourceName u Integer
|
||||
integer = decimal <$> many1 digit <?> "decimal number"
|
||||
where
|
||||
decimal = foldl (\x d -> 10 * x + toInteger (digitToInt d)) 0
|
||||
|
||||
-- parse alias mapping specification from the command line --using flags
|
||||
-- e.g.: --using="OrderedSet=SortedSet<{0}>"
|
||||
parseAliasMapping :: [String] -> IO [AliasMapping]
|
||||
parseAliasMapping = mapM parseAliasMapping
|
||||
parseAliasMappings :: [String] -> IO [AliasMapping]
|
||||
parseAliasMappings = mapM parseAliasMapping
|
||||
where
|
||||
parseAliasMapping s = case parse aliasMapping s s of
|
||||
Left err -> fail $ show err
|
||||
|
|
@ -55,8 +62,8 @@ parseAliasMapping = mapM parseAliasMapping
|
|||
|
||||
-- parse namespace mapping specification from the command line --namespace flags
|
||||
-- e.g.: --namespace="bond="
|
||||
parseNamespaceMapping :: [String] -> IO [NamespaceMapping]
|
||||
parseNamespaceMapping = mapM parseNamespaceMapping
|
||||
parseNamespaceMappings :: [String] -> IO [NamespaceMapping]
|
||||
parseNamespaceMappings = mapM parseNamespaceMapping
|
||||
where
|
||||
parseNamespaceMapping s = case parse namespaceMapping s s of
|
||||
Left err -> fail $ show err
|
||||
|
|
|
|||
|
|
@ -4,8 +4,7 @@
|
|||
{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
|
||||
|
||||
module Bond.Template.TypeMapping
|
||||
( newMappingContext
|
||||
, findAliasMapping
|
||||
( findAliasMapping
|
||||
, setTypeMapping
|
||||
, setNamespaces
|
||||
, cppTypeMapping
|
||||
|
|
@ -22,6 +21,7 @@ module Bond.Template.TypeMapping
|
|||
, getDeclQualifiedTypeName
|
||||
, getTypeName
|
||||
, getInstanceTypeName
|
||||
, MappingContext(..)
|
||||
) where
|
||||
|
||||
import Data.List
|
||||
|
|
@ -36,7 +36,7 @@ import Bond.Util
|
|||
import Bond.Template.Util
|
||||
import Bond.Template.CustomMapping
|
||||
|
||||
data Context = Context
|
||||
data MappingContext = MappingContext
|
||||
{ typeMapping :: TypeMapping
|
||||
, aliasMapping :: [AliasMapping]
|
||||
, namespaceMapping :: [NamespaceMapping]
|
||||
|
|
@ -53,23 +53,21 @@ data TypeMapping = TypeMapping
|
|||
, elementMapping :: TypeMapping
|
||||
}
|
||||
|
||||
type TypeNameBuilder = Reader Context Builder
|
||||
type TypeNameBuilder = Reader MappingContext Builder
|
||||
|
||||
newMappingContext = Context
|
||||
|
||||
setTypeMapping :: Context -> TypeMapping -> Context
|
||||
setTypeMapping :: MappingContext -> TypeMapping -> MappingContext
|
||||
setTypeMapping c m = c { typeMapping = m }
|
||||
|
||||
setNamespaces :: Context -> [Namespace] -> Context
|
||||
setNamespaces :: MappingContext -> [Namespace] -> MappingContext
|
||||
setNamespaces c n = c { namespaces = n }
|
||||
|
||||
getNamespace :: Context -> QualifiedName
|
||||
getNamespace c@Context {..} = resolveNamespace c namespaces
|
||||
getNamespace :: MappingContext -> QualifiedName
|
||||
getNamespace c@MappingContext {..} = resolveNamespace c namespaces
|
||||
|
||||
getIdlNamespace :: Context -> QualifiedName
|
||||
getIdlNamespace c@Context {..} = findNamespace c namespaces
|
||||
getIdlNamespace :: MappingContext -> QualifiedName
|
||||
getIdlNamespace c@MappingContext {..} = findNamespace c namespaces
|
||||
|
||||
getDeclNamespace :: Context -> Declaration -> QualifiedName
|
||||
getDeclNamespace :: MappingContext -> Declaration -> QualifiedName
|
||||
getDeclNamespace c = resolveNamespace c . declNamespaces
|
||||
|
||||
getQualifiedName :: TypeMapping -> QualifiedName -> Builder
|
||||
|
|
@ -81,18 +79,19 @@ getIdlQualifiedName = sep "."
|
|||
getGlobalQualifiedName :: TypeMapping -> QualifiedName -> Builder
|
||||
getGlobalQualifiedName m@TypeMapping {..} = (global <>) . getQualifiedName m
|
||||
|
||||
getDeclQualifiedTypeName :: Context -> Declaration -> Builder
|
||||
getDeclQualifiedTypeName :: MappingContext -> Declaration -> Builder
|
||||
getDeclQualifiedTypeName c = getGlobalQualifiedName (typeMapping c) . declQualifiedName c
|
||||
|
||||
getTypeName :: Context -> Type -> Builder
|
||||
getTypeName c t = fix $ runReader (typeName t) c
|
||||
getTypeName :: MappingContext -> Type -> Builder
|
||||
getTypeName c t = fix' $ runReader (typeName t) c
|
||||
where
|
||||
fix = fixSyntax $ typeMapping c
|
||||
fix' = fixSyntax $ typeMapping c
|
||||
|
||||
getInstanceTypeName :: Context -> Type -> Builder
|
||||
getInstanceTypeName :: MappingContext -> Type -> Builder
|
||||
getInstanceTypeName c t = runReader (instanceTypeName t) c
|
||||
|
||||
-- type mappings for different languages/variants
|
||||
cppTypeMapping :: TypeMapping
|
||||
cppTypeMapping = TypeMapping
|
||||
Cpp
|
||||
"::"
|
||||
|
|
@ -102,6 +101,7 @@ cppTypeMapping = TypeMapping
|
|||
cppTypeMapping
|
||||
cppTypeMapping
|
||||
|
||||
cppCustomAllocTypeMapping :: ToText a => a -> TypeMapping
|
||||
cppCustomAllocTypeMapping alloc = TypeMapping
|
||||
Cpp
|
||||
"::"
|
||||
|
|
@ -111,6 +111,7 @@ cppCustomAllocTypeMapping alloc = TypeMapping
|
|||
(cppCustomAllocTypeMapping alloc)
|
||||
(cppCustomAllocTypeMapping alloc)
|
||||
|
||||
csTypeMapping :: TypeMapping
|
||||
csTypeMapping = TypeMapping
|
||||
Cs
|
||||
"global::"
|
||||
|
|
@ -120,6 +121,7 @@ csTypeMapping = TypeMapping
|
|||
csTypeMapping
|
||||
csTypeMapping
|
||||
|
||||
csInterfaceTypeMapping :: TypeMapping
|
||||
csInterfaceTypeMapping = TypeMapping
|
||||
Cs
|
||||
"global::"
|
||||
|
|
@ -129,8 +131,10 @@ csInterfaceTypeMapping = TypeMapping
|
|||
csInterfaceInstanceTypeMapping
|
||||
csInterfaceTypeMapping
|
||||
|
||||
csInterfaceInstanceTypeMapping :: TypeMapping
|
||||
csInterfaceInstanceTypeMapping = csInterfaceTypeMapping {mapType = csType}
|
||||
|
||||
csAnnotatedTypeMapping :: TypeMapping
|
||||
csAnnotatedTypeMapping = TypeMapping
|
||||
Cs
|
||||
"global::"
|
||||
|
|
@ -158,6 +162,7 @@ infixr 6 <<>
|
|||
pureText :: ToText a => a -> TypeNameBuilder
|
||||
pureText = pure . toText
|
||||
|
||||
commaSepTypeNames :: [Type] -> TypeNameBuilder
|
||||
commaSepTypeNames [] = return mempty
|
||||
commaSepTypeNames [x] = typeName x
|
||||
commaSepTypeNames (x:xs) = typeName x <<>> ", " <>> commaSepTypeNames xs
|
||||
|
|
@ -176,16 +181,17 @@ elementTypeName = localWith elementMapping . typeName
|
|||
instanceTypeName :: Type -> TypeNameBuilder
|
||||
instanceTypeName = localWith instanceMapping . typeName
|
||||
|
||||
resolveNamespace :: Context -> [Namespace] -> QualifiedName
|
||||
resolveNamespace c@Context {..} ns = maybe namespace toNamespace $ find ((namespace ==) . fromNamespace) namespaceMapping
|
||||
resolveNamespace :: MappingContext -> [Namespace] -> QualifiedName
|
||||
resolveNamespace c@MappingContext {..} ns = maybe namespace toNamespace $ find ((namespace ==) . fromNamespace) namespaceMapping
|
||||
where
|
||||
namespace = findNamespace c ns
|
||||
|
||||
-- last namespace that is language-neutral or matches the language of the context's type mapping
|
||||
findNamespace Context {..} ns =
|
||||
findNamespace :: MappingContext -> [Namespace] -> QualifiedName
|
||||
findNamespace MappingContext {..} ns =
|
||||
nsName . last . filter (maybe True (language typeMapping ==) . nsLanguage) $ ns
|
||||
|
||||
declQualifiedName :: Context -> Declaration -> QualifiedName
|
||||
declQualifiedName :: MappingContext -> Declaration -> QualifiedName
|
||||
declQualifiedName c decl = getDeclNamespace c decl ++ [declName decl]
|
||||
|
||||
declQualifiedTypeName :: Declaration -> TypeNameBuilder
|
||||
|
|
@ -200,7 +206,7 @@ declTypeName decl = do
|
|||
then pureText $ declName decl
|
||||
else declQualifiedTypeName decl
|
||||
|
||||
findAliasMapping :: Context -> Declaration -> Maybe AliasMapping
|
||||
findAliasMapping :: MappingContext -> Declaration -> Maybe AliasMapping
|
||||
findAliasMapping ctx a = find isSameAlias $ aliasMapping ctx
|
||||
where
|
||||
aliasDeclName = declQualifiedName ctx a
|
||||
|
|
@ -248,23 +254,27 @@ 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 " <> alloc <> "::rebind<char>::other>"
|
||||
cppTypeCustomAlloc alloc BT_WString = pure $ "std::basic_string<wchar_t, std::char_traits<wchar_t>, typename " <> alloc <> "::rebind<wchar_t>::other>"
|
||||
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) | structType element = "bond::nullable<" <>> elementTypeName element <<> ", " <> alloc <> ">"
|
||||
cppTypeCustomAlloc alloc (BT_Nullable element) = "bond::nullable<" <>> elementTypeName element <<> ">"
|
||||
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
|
||||
|
||||
comparer :: Type -> TypeNameBuilder
|
||||
comparer t = ", std::less<" <>> elementTypeName t <<> ">, "
|
||||
|
||||
allocator :: Builder -> Type -> TypeNameBuilder
|
||||
allocator alloc element =
|
||||
"typename " <>> alloc <>> "::rebind<" <>> elementTypeName element <<> ">::other"
|
||||
|
||||
pairAllocator :: Builder -> Type -> Type -> TypeNameBuilder
|
||||
pairAllocator alloc key value =
|
||||
"typename " <>> alloc <>> "::rebind<" <>> "std::pair<const " <>> elementTypeName key <<>> ", " <>> elementTypeName value <<> "> >::other"
|
||||
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
-- Licensed under the MIT license. See LICENSE file in the project root for full license information.
|
||||
|
||||
{-# LANGUAGE QuasiQuotes, OverloadedStrings #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module Bond.Template.Util
|
||||
( toText
|
||||
|
|
@ -21,16 +22,14 @@ module Bond.Template.Util
|
|||
, doubleLineSepEnd
|
||||
) where
|
||||
|
||||
import System.FilePath
|
||||
import Data.Int (Int64)
|
||||
import Data.Monoid
|
||||
import Data.Word
|
||||
import Data.String
|
||||
import Data.Text.Lazy (justifyRight)
|
||||
import Data.Text.Lazy (Text, justifyRight)
|
||||
import Data.Text.Lazy.Builder
|
||||
import Text.Shakespeare.Text
|
||||
import Bond.Version
|
||||
import Bond.Util
|
||||
import Bond.Schema
|
||||
|
||||
instance ToText Word16 where
|
||||
toText = toText . show
|
||||
|
|
@ -41,27 +40,36 @@ instance ToText Double where
|
|||
instance ToText Integer where
|
||||
toText = toText . show
|
||||
|
||||
mconcatMap :: Monoid b => (a -> b) -> [a] -> b
|
||||
mconcatMap f = foldr (mappend . f) mempty
|
||||
|
||||
mconcatFor :: Monoid b => [a] -> (a -> b) -> b
|
||||
mconcatFor m f = mconcatMap f m
|
||||
|
||||
sep :: ToText t => Builder -> [t] -> Builder
|
||||
sep s = sepBy s toText
|
||||
|
||||
commaSep :: ToText t => [t] -> Builder
|
||||
commaSep = sepBy ", " toText
|
||||
|
||||
indent :: Int64 -> Text
|
||||
indent n = justifyRight (4 * n) ' ' ""
|
||||
|
||||
commaLine :: Int64 -> Text
|
||||
commaLine n = [lt|,
|
||||
#{indent n}|]
|
||||
|
||||
newLine :: Int64 -> Text
|
||||
newLine n = [lt|
|
||||
#{indent n}|]
|
||||
|
||||
doubleLine :: Int64 -> Text
|
||||
doubleLine n = [lt|
|
||||
|
||||
#{indent n}|]
|
||||
|
||||
newlineSep, commaLineSep, newlineSepEnd, newlineBeginSep, doubleLineSep
|
||||
, doubleLineSepEnd :: Int64 -> (t -> Text) -> [t] -> Text
|
||||
newlineSep = sepBy . newLine
|
||||
commaLineSep = sepBy . commaLine
|
||||
newlineSepEnd = sepEndBy . newLine
|
||||
|
|
@ -69,6 +77,7 @@ newlineBeginSep = sepBeginBy . newLine
|
|||
doubleLineSep = sepBy . doubleLine
|
||||
doubleLineSepEnd = sepEndBy . doubleLine
|
||||
|
||||
commonHeader :: ToText a => a -> Text
|
||||
commonHeader file = [lt|
|
||||
//------------------------------------------------------------------------------
|
||||
// This code was generated by a tool.
|
||||
|
|
|
|||
|
|
@ -16,8 +16,11 @@ module Bond.Util
|
|||
) where
|
||||
|
||||
import Data.Monoid
|
||||
import Data.String (IsString)
|
||||
|
||||
sepEndBy s f [] = mempty
|
||||
sepEndBy :: (Monoid a, Eq a)
|
||||
=> a -> (t -> a) -> [t] -> a
|
||||
sepEndBy _ _ [] = mempty
|
||||
sepEndBy s f (x:xs)
|
||||
| next == mempty = rest
|
||||
| otherwise = next <> s <> rest
|
||||
|
|
@ -25,7 +28,9 @@ sepEndBy s f (x:xs)
|
|||
next = f x
|
||||
rest = sepEndBy s f xs
|
||||
|
||||
sepBeginBy s f [] = mempty
|
||||
sepBeginBy :: (Monoid a, Eq a)
|
||||
=> a -> (t -> a) -> [t] -> a
|
||||
sepBeginBy _ _ [] = mempty
|
||||
sepBeginBy s f (x:xs)
|
||||
| next == mempty = rest
|
||||
| otherwise = s <> next <> rest
|
||||
|
|
@ -33,7 +38,9 @@ sepBeginBy s f (x:xs)
|
|||
next = f x
|
||||
rest = sepBeginBy s f xs
|
||||
|
||||
sepBy s f [] = mempty
|
||||
sepBy :: (Monoid a, Eq a)
|
||||
=> a -> (t -> a) -> [t] -> a
|
||||
sepBy _ _ [] = mempty
|
||||
sepBy s f (x:xs)
|
||||
| null xs = next
|
||||
| next == mempty = rest
|
||||
|
|
@ -45,10 +52,14 @@ sepBy s f (x:xs)
|
|||
optional :: (Monoid m) => (a -> m) -> Maybe a -> m
|
||||
optional = maybe mempty
|
||||
|
||||
between :: (Monoid a, Eq a) => a -> a -> a -> a
|
||||
between l r m
|
||||
| m == mempty = mempty
|
||||
| otherwise = l <> m <> r
|
||||
|
||||
angles, brackets, braces, parens
|
||||
:: (Monoid a, IsString a, Eq a)
|
||||
=> a -> a
|
||||
angles m = between "<" ">" m
|
||||
brackets m = between "[" "]" m
|
||||
braces m = between "{" "}" m
|
||||
|
|
|
|||
|
|
@ -6,5 +6,7 @@ module Bond.Version
|
|||
, minorVersion
|
||||
) where
|
||||
|
||||
majorVersion :: String
|
||||
majorVersion = "3"
|
||||
minorVersion :: String
|
||||
minorVersion = "02"
|
||||
|
|
|
|||
|
|
@ -15,8 +15,10 @@ import Control.Monad.Reader
|
|||
import Control.Monad.Loops (firstM)
|
||||
import Control.Concurrent.Async
|
||||
import GHC.Conc (getNumProcessors, setNumCapabilities)
|
||||
import Data.Text.Lazy (Text)
|
||||
import qualified Data.Text.Lazy.IO as L
|
||||
import Bond.Parser
|
||||
import Bond.Schema (Declaration, Import)
|
||||
import Bond.Template.Util
|
||||
import Bond.Template.Cpp.Reflection_h
|
||||
import Bond.Template.Cpp.Types_h
|
||||
|
|
@ -39,6 +41,7 @@ main = do
|
|||
Cs {..} -> csCodegen options
|
||||
_ -> print options
|
||||
|
||||
setJobs :: Maybe Int -> IO ()
|
||||
setJobs Nothing = return ()
|
||||
setJobs (Just n)
|
||||
| n > 0 = setNumCapabilities n
|
||||
|
|
@ -47,16 +50,17 @@ setJobs (Just n)
|
|||
-- if n is less than 0 use that many fewer jobs than processors
|
||||
setNumCapabilities $ max 1 (numProc + n)
|
||||
|
||||
concurrentlyFor_ :: [a] -> (a -> IO b) -> IO ()
|
||||
concurrentlyFor_ = (void .) . flip mapConcurrently
|
||||
|
||||
cppCodegen :: Options -> IO()
|
||||
cppCodegen (Cpp {..}) = do
|
||||
aliasMapping <- parseAliasMapping using
|
||||
namespaceMapping <- parseNamespaceMapping namespace
|
||||
aliasMapping <- parseAliasMappings using
|
||||
namespaceMapping <- parseNamespaceMappings namespace
|
||||
let typeMapping = case allocator of
|
||||
Nothing -> cppTypeMapping
|
||||
Just a -> cppCustomAllocTypeMapping a
|
||||
let mappingContext = newMappingContext typeMapping aliasMapping namespaceMapping []
|
||||
let mappingContext = MappingContext typeMapping aliasMapping namespaceMapping []
|
||||
concurrentlyFor_ files $ codeGen output_dir import_dir mappingContext $
|
||||
[ reflection_h
|
||||
, types_cpp
|
||||
|
|
@ -73,19 +77,27 @@ cppCodegen (Cpp {..}) = do
|
|||
, (Fast, Protocol "FastBinaryReader" "FastBinaryWriter")
|
||||
, (Simple, Protocol "SimpleBinaryReader" "SimpleBinaryWriter")
|
||||
]
|
||||
cppCodegen _ = error "cppCodegen: impossible happened."
|
||||
|
||||
|
||||
csCodegen :: Options -> IO()
|
||||
csCodegen (Cs {..}) = do
|
||||
aliasMapping <- parseAliasMapping using
|
||||
namespaceMapping <- parseNamespaceMapping namespace
|
||||
aliasMapping <- parseAliasMappings using
|
||||
namespaceMapping <- parseNamespaceMappings namespace
|
||||
let typeMapping = if collection_interfaces then csInterfaceTypeMapping else csTypeMapping
|
||||
let mappingContext = newMappingContext typeMapping aliasMapping namespaceMapping []
|
||||
let mappingContext = MappingContext typeMapping aliasMapping namespaceMapping []
|
||||
concurrentlyFor_ files $ codeGen output_dir import_dir mappingContext
|
||||
[ types_cs readonly_properties fields
|
||||
]
|
||||
csCodegen _ = error "csCodegen: impossible happened."
|
||||
|
||||
|
||||
codeGen :: FilePath
|
||||
-> [FilePath]
|
||||
-> MappingContext
|
||||
-> [MappingContext -> String -> [Import] -> [Declaration] -> (String, Text)]
|
||||
-> FilePath
|
||||
-> IO ()
|
||||
codeGen outputDir importDirs mappingContext templates file = do
|
||||
cwd <- getCurrentDirectory
|
||||
input <- readFileUtf8 file
|
||||
|
|
|
|||
|
|
@ -9,7 +9,6 @@ module Options (getOptions, Options(..), ApplyOptions(..)) where
|
|||
|
||||
import Bond.Version
|
||||
import System.Console.CmdArgs
|
||||
import System.Console.CmdArgs.Explicit (Mode(..))
|
||||
|
||||
data ApplyOptions =
|
||||
Compact |
|
||||
|
|
@ -45,6 +44,7 @@ data Options
|
|||
}
|
||||
deriving (Show, Data, Typeable)
|
||||
|
||||
cpp :: Options
|
||||
cpp = Cpp
|
||||
{ files = def &= typFile &= args
|
||||
, import_dir = def &= typDir &= help "Add the directory to import search path"
|
||||
|
|
@ -61,6 +61,7 @@ cpp = Cpp
|
|||
name "c++" &=
|
||||
help "Generate C++ code"
|
||||
|
||||
cs :: Options
|
||||
cs = Cs
|
||||
{ collection_interfaces = def &= help "Use interfaces rather than concrete collection types"
|
||||
, readonly_properties = def &= help "Generate private property setters"
|
||||
|
|
@ -69,9 +70,11 @@ cs = Cs
|
|||
name "c#" &=
|
||||
help "Generate C# code"
|
||||
|
||||
mode :: Mode (CmdArgs Options)
|
||||
mode = cmdArgsMode $ modes [cpp, cs] &=
|
||||
program "gbc" &=
|
||||
help "Compile Bond schema definition file and generate specified output" &=
|
||||
summary ("Bond Compiler " ++ majorVersion ++ "." ++ minorVersion ++ ", (C) Microsoft")
|
||||
|
||||
getOptions :: IO Options
|
||||
getOptions = cmdArgsRun mode
|
||||
|
|
|
|||
Загрузка…
Ссылка в новой задаче