msgpack-idl 0.2.0 → 0.2.1
raw patch · 12 files changed
+318/−135 lines, 12 filesdep ~bytestringdep ~cmdargsdep ~containers
Dependency ranges changed: bytestring, cmdargs, containers, directory, template-haskell, text
Files
- Language/MessagePack/IDL/CodeGen/Cpp.hs +29/−25
- Language/MessagePack/IDL/CodeGen/Erlang.hs +189/−0
- Language/MessagePack/IDL/CodeGen/Haskell.hs +5/−6
- Language/MessagePack/IDL/CodeGen/Java.hs +46/−27
- Language/MessagePack/IDL/CodeGen/Perl.hs +0/−42
- Language/MessagePack/IDL/CodeGen/Php.hs +3/−3
- Language/MessagePack/IDL/CodeGen/Python.hs +11/−13
- Language/MessagePack/IDL/CodeGen/Ruby.hs +9/−8
- Language/MessagePack/IDL/Syntax.hs +1/−2
- exec/main.hs +12/−0
- mpidl.peggy +5/−2
- msgpack-idl.cabal +8/−7
Language/MessagePack/IDL/CodeGen/Cpp.hs view
@@ -46,7 +46,7 @@ | otherwise = [lt|#include <msgpack/rpc/client.h>|] - LT.writeFile (name ++ "_types.hpp") $ templ configFilePath once "TYPES" [lt|+ LT.writeFile (name ++ "_types.hpp") $ templ configFilePath ns once "TYPES" [lt| #include <vector> #include <map> #include <string>@@ -57,14 +57,14 @@ #{genNameSpace ns $ LT.concat $ map (genTypeDecl name) spec } |] - LT.writeFile (name ++ "_server.hpp") $ templ configFilePath once "SERVER" [lt|+ LT.writeFile (name ++ "_server.hpp") $ templ configFilePath (snoc ns "server") once "SERVER" [lt| #include "#{name}_types.hpp" #{serverHeader} #{genNameSpace (snoc ns "server") $ LT.concat $ map (genServer configPFICommon) spec} |] - LT.writeFile (name ++ "_client.hpp") [lt|+ LT.writeFile (name ++ "_client.hpp") $ templ configFilePath (snoc ns "client") once "CLIENT" [lt| #include "#{name}_types.hpp" #{clientHeader} @@ -131,12 +131,12 @@ where genMethodDispatch Function {..} = -- TODO: FIX IT!- let typs = map (genType . maybe TVoid fldType) $ sortField methodArgs in+ let typs = map (genRetType . maybe Nothing (Just . fldType)) $ sortField methodArgs in let params = map g methodArgs in case params of [] -> [lt| if (method == "#{methodName}") {- req.result<#{genType methodRetType} >(static_cast<Impl*>(this)->#{methodName}());+ req.result<#{genRetType methodRetType} >(static_cast<Impl*>(this)->#{methodName}()); return; } |]@@ -144,7 +144,7 @@ if (method == "#{methodName}") { msgpack::type::tuple<#{LT.intercalate ", " typs} > params; req.params().convert(¶ms);- req.result<#{genType methodRetType} >(static_cast<Impl*>(this)->#{methodName}(#{LT.intercalate ", " params}));+ req.result<#{genRetType methodRetType} >(static_cast<Impl*>(this)->#{methodName}(#{LT.intercalate ", " params})); return; } |]@@ -164,8 +164,8 @@ |] where genSetMethod Function {..} =- let typs = map (genType . maybe TVoid fldType) $ sortField methodArgs- sign = [lt|#{genType methodRetType}(#{LT.intercalate ", " typs})|]+ let typs = map (genRetType . maybe Nothing (Just . fldType)) $ sortField methodArgs+ sign = [lt|#{genRetType methodRetType}(#{LT.intercalate ", " typs})|] phs = LT.concat $ [[lt|, pfi::lang::_#{show ix}|] | ix <- [1 .. length (typs)]] in [lt| rpc_server::add<#{sign} >("#{methodName}", pfi::lang::bind(&Impl::#{methodName}, static_cast<Impl*>(this)#{phs}));|]@@ -190,14 +190,14 @@ let args = LT.intercalate ", " $ map arg methodArgs in let vals = LT.concat $ map val methodArgs in case methodRetType of- TVoid -> [lt|+ Nothing -> [lt| void #{methodName}(#{args}) { c_.call("#{methodName}"#{vals}); } |]- _ -> [lt|- #{genType methodRetType} #{methodName}(#{args}) {- return c_.call("#{methodName}"#{vals}).get<#{genType methodRetType} >();+ Just typ -> [lt|+ #{genType typ} #{methodName}(#{args}) {+ return c_.call("#{methodName}"#{vals}).get<#{genType typ} >(); } |] where@@ -217,18 +217,18 @@ |] where genMethodCall Function {..} =- let typs = map (genType . maybe TVoid fldType) $ sortField methodArgs- sign = [lt|#{genType methodRetType}(#{LT.intercalate ", " typs})|]+ let typs = map (genRetType . maybe Nothing (\f -> Just (fldType f))) $ sortField methodArgs+ sign = [lt|#{genRetType methodRetType}(#{LT.intercalate ", " typs})|] args = LT.intercalate ", " $ map arg methodArgs vals = LT.intercalate ", " $ map val methodArgs in case methodRetType of- TVoid -> [lt|+ Nothing -> [lt| void #{methodName}(#{args}) { call<#{sign}>("#{methodName}")(#{vals}); } |]- _ -> [lt|- #{genType methodRetType} #{methodName}(#{args}) {+ Just t -> [lt|+ #{genType t} #{methodName}(#{args}) { return call<#{sign}>("#{methodName}")(#{vals}); } |]@@ -265,21 +265,25 @@ foldr1 (\t1 t2 -> [lt|std::pair<#{t1}, #{t2} >|]) $ map genType ts genType TObject = [lt|msgpack::object|]-genType TVoid =- [lt|void|] -templ :: FilePath -> String -> String -> LT.Text -> LT.Text-templ filepath once name content = [lt|+genRetType :: Maybe Type -> LT.Text+genRetType Nothing = [lt|void|]+genRetType (Just t) = genType t++templ :: FilePath -> [LT.Text] -> String -> String -> LT.Text -> LT.Text+templ filepath ns once name content = [lt| // This file is auto-generated from #{filepath} // *** DO NOT EDIT *** -#ifndef #{once}_#{name}_HPP_-#define #{once}_#{name}_HPP_+#ifndef #{namespace}_#{once}_#{name}_HPP_+#define #{namespace}_#{once}_#{name}_HPP_ #{content} -#endif // #{once}_#{name}_HPP_-|]+#endif // #{namespace}_#{once}_#{name}_HPP_+|] where+ namespace = LT.intercalate "_" $ map LT.toUpper ns+ genNameSpace :: [LT.Text] -> LT.Text -> LT.Text genNameSpace namespace content = f namespace
+ Language/MessagePack/IDL/CodeGen/Erlang.hs view
@@ -0,0 +1,189 @@+{-# LANGUAGE QuasiQuotes, RecordWildCards, OverloadedStrings #-}++module Language.MessagePack.IDL.CodeGen.Erlang (+ Config(..),+ generate,+ ) where++import Data.Char+import Data.List+import qualified Data.Text as T+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.IO as LT+import System.FilePath+import Text.Shakespeare.Text++import Language.MessagePack.IDL.Syntax++data Config+ = Config+ { configFilePath :: FilePath+ }+ deriving (Show, Eq)++generate:: Config -> Spec -> IO ()+generate Config {..} spec = do+ let name = takeBaseName configFilePath+ once = map toUpper name++ headerFile = name ++ "_types.hrl"++ LT.writeFile (headerFile) $ templ configFilePath once "TYPES" [lt|+-ifndef(#{once}).+-define(#{once}, 1).++-type mp_string() :: binary().++#{LT.concat $ map (genTypeDecl name) spec }++-endif.+|]++ LT.writeFile (name ++ "_server.tmpl.erl") $ templ configFilePath once "SERVER" [lt|++-module(#{name}_server).+-author('@msgpack-idl').++-include("#{headerFile}").++#{LT.concat $ map genServer spec}+|]++ LT.writeFile (name ++ "_client.erl") [lt|+% This file is automatically generated by msgpack-idl.+-module(#{name}_client).+-author('@msgpack-idl').++-include("#{headerFile}").+-export([connect/3, close/1]).++#{LT.concat $ map genClient spec}+|]++genTypeDecl :: String -> Decl -> LT.Text+genTypeDecl _ MPMessage {..} =+ genMsg msgName msgFields False++genTypeDecl _ MPException {..} =+ genMsg excName excFields True++genTypeDecl _ MPType { .. } =+ [lt|+-type #{tyName}() :: #{genType tyType}.+|]++genTypeDecl _ _ = ""++genMsg name flds isExc =+ let fields = map f flds+ in [lt|+-type #{name}() :: [+ #{LT.intercalate "\n | " fields}+ ]. % #{e}+|]+ where+ e = if isExc then [lt| (exception)|] else ""+ f Field {..} = [lt|#{genType fldType} % #{fldName}|]++sortField flds =+ flip map [0 .. maximum $ [-1] ++ map fldId flds] $ \ix ->+ find ((==ix). fldId) flds++makeExport i Function {..} =+ let j = i + length methodArgs in+ [lt|#{methodName}/#{show j}|]+makeExport _ _ = ""+++genServer :: Decl -> LT.Text+genServer MPService {..} = [lt|++-export([#{LT.intercalate ", " $ map (makeExport 0) serviceMethods}]).++#{LT.concat $ map genSetMethod serviceMethods}++|]+ where+ genSetMethod Function {..} =+ let typs = map (genRetType . maybe Nothing (Just . fldType)) $ sortField methodArgs+ args = map f methodArgs+ f Field {..} = [lt|#{capitalize0 fldName}|]+ capitalize0 str = T.cons (toUpper $ T.head str) (T.tail str)++ in [lt|+-spec #{methodName}(#{LT.intercalate ", " typs}) -> #{genRetType methodRetType}.+#{methodName}(#{LT.intercalate ", " args}) ->+ Reply = <<"ok">>, % write your code here+ Reply.+|]+ genSetMethod _ = ""++genServer _ = ""++genClient :: Decl -> LT.Text+genClient MPService {..} = [lt|++-export([#{LT.intercalate ", " $ map (makeExport 1) serviceMethods}]).++-spec connect(inet:ip_address(), inet:port_number(), [proplists:property()]) -> {ok, pid()} | {error, any()}.+connect(Host,Port,Options)->+ msgpack_rpc_client:connect(tcp,Host,Port,Options).++-spec close(pid())-> ok.+close(Pid)->+ msgpack_rpc_client:close(Pid).++#{LT.concat $ map genMethodCall serviceMethods}+|]+ where+ genMethodCall Function {..} =+ let typs = map (genRetType . maybe Nothing (Just . fldType)) $ sortField methodArgs+ args = map f methodArgs+ f Field {..} = [lt|#{capitalize0 fldName}|]+ capitalize0 str = T.cons (toUpper $ T.head str) (T.tail str)+ in [lt|+-spec #{methodName}(pid(), #{LT.intercalate ", " typs}) -> #{genRetType methodRetType}.+#{methodName}(Pid, #{LT.intercalate ", " args}) ->+ msgpack_rpc_client:call(Pid, #{methodName}, [#{LT.intercalate ", " args}]).+|]+ where+ arg Field {..} = [lt|#{genType fldType} #{fldName}|]+ val Field {..} = [lt|#{fldName}|]++ genMethodCall _ = ""++genClient _ = ""++genType :: Type -> LT.Text+genType (TInt sign bits) =+ let base = if sign then "non_neg_integer" else "integer" :: LT.Text in+ [lt|#{base}()|]+genType (TFloat _) =+ [lt|float()|]+genType TBool =+ [lt|boolean()|]+genType TRaw =+ [lt|binary()|]+genType TString =+ [lt|mp_string()|]+genType (TList typ) =+ [lt|list(#{genType typ})|]+genType (TMap typ1 typ2) =+ [lt|list({#{genType typ1}, #{genType typ2}})|]+genType (TUserDef className params) =+ [lt|#{className}()|]+genType (TTuple ts) =+ -- TODO: FIX+ foldr1 (\t1 t2 -> [lt|{#{t1}, #{t2}}|]) $ map genType ts+genType TObject =+ [lt|term()|]++genRetType :: Maybe Type -> LT.Text+genRetType Nothing = [lt|void()|]+genRetType (Just t) = genType t++templ :: FilePath -> String -> String -> LT.Text -> LT.Text+templ filepath once name content = [lt|+% This file is auto-generated from #{filepath}++#{content}|]
Language/MessagePack/IDL/CodeGen/Haskell.hs view
@@ -67,7 +67,7 @@ monadName = classize (serviceName) `mappend` "T" genMethod Function {..} = let ts = map (genType . fldType) methodArgs in- let typs = ts ++ [ [lt|#{monadName} (#{genType methodRetType})|] ] in+ let typs = ts ++ [ [lt|#{monadName} (#{genRetType methodRetType})|] ] in [lt| #{methodize methodName} :: #{LT.intercalate " -> " typs} #{methodize methodName} = MP.method "#{methodName}"@@ -119,9 +119,11 @@ [lt|#{classize name}|] genType (TObject) = undefined-genType (TVoid) =- [lt|()|] +genRetType :: Maybe Type -> LT.Text+genRetType Nothing = "()"+genRetType (Just t) = genType t+ classize :: T.Text -> T.Text classize = capital . camelize @@ -198,9 +200,6 @@ genType (TTuple typs) = foldl appT (tupleT (length typs)) (map genType typs)--genType TVoid =- tupleT 0 capital (c:cs) = toUpper c : cs capital cs = cs
Language/MessagePack/IDL/CodeGen/Java.hs view
@@ -11,6 +11,7 @@ import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.IO as LT import System.FilePath+import System.Directory import Text.Shakespeare.Text import Language.MessagePack.IDL.Syntax@@ -25,11 +26,13 @@ generate :: Config -> Spec -> IO() generate config spec = do let typeAlias = map genAlias $ filter isMPType spec+ dirName = joinPath $ map LT.unpack $ LT.split (== '.') $ LT.pack $ configPackage config genTuple config+ createDirectoryIfMissing True dirName mapM_ (genClient typeAlias config) spec- mapM_ (genStruct typeAlias $ configPackage config) spec- mapM_ (genException $ configPackage config) spec+ mapM_ (genStruct typeAlias config) spec+ mapM_ (genException typeAlias config) spec {-- LT.writeFile (name ++ "Server.java") $ templ (configFilePath ++ configPackage ++"/server/")[lt|@@ -56,21 +59,26 @@ |] genImport _ _ = "" -genStruct :: [(T.Text, Type)] -> FilePath -> Decl -> IO()-genStruct alias packageName MPMessage {..} = do+genStruct :: [(T.Text, Type)] -> Config -> Decl -> IO()+genStruct alias Config{..} MPMessage {..} = do let params = if null msgParam then "" else [lt|<#{T.intercalate ", " msgParam}>|] resolvedMsgFields = map (resolveFieldAlias alias) msgFields hashMapImport | not $ null [() | TMap _ _ <- map fldType resolvedMsgFields] = [lt|import java.util.HashMap;|] | otherwise = "" arrayListImport | not $ null [() | TList _ <- map fldType resolvedMsgFields] = [lt|import java.util.ArrayList;|] | otherwise = ""+ dirName = joinPath $ map LT.unpack $ LT.split (== '.') $ LT.pack configPackage+ fileName = dirName ++ "/" ++ (T.unpack $ formatClassNameT msgName) ++ ".java" - LT.writeFile ( (formatClassName $ T.unpack msgName) ++ ".java") [lt|-package #{packageName};+ LT.writeFile fileName $ templ configFilePath [lt|+package #{configPackage}; #{hashMapImport} #{arrayListImport}+import org.msgpack.MessagePack;+import org.msgpack.annotation.Message; +@Message public class #{formatClassNameT msgName} #{params} { #{LT.concat $ map genDecl resolvedMsgFields}@@ -82,15 +90,15 @@ genStruct _ _ _ = return () resolveMethodAlias :: [(T.Text, Type)] -> Method -> Method-resolveMethodAlias alias Function {..} = Function methodInherit methodName (resolveTypeAlias alias methodRetType) (map (resolveFieldAlias alias) methodArgs)+resolveMethodAlias alias Function {..} = Function methodInherit methodName (resolveRetTypeAlias alias methodRetType) (map (resolveFieldAlias alias) methodArgs) resolveMethodAlias _ f = f resolveFieldAlias :: [(T.Text, Type)] -> Field -> Field resolveFieldAlias alias Field {..} = Field fldId (resolveTypeAlias alias fldType) fldName fldDefault resolveTypeAlias :: [(T.Text, Type)] -> Type -> Type-resolveTypeAlias alias ty = let fixedAlias = resolveTypeAlias alias in - case ty of+resolveTypeAlias alias ty = let fixedAlias = resolveTypeAlias alias in+ case ty of TNullable t -> TNullable $ fixedAlias t TList t ->@@ -103,8 +111,12 @@ case lookup className alias of Just resolvedType -> resolvedType Nothing -> TUserDef className (map fixedAlias params)- otherwise -> ty+ _ -> ty +resolveRetTypeAlias :: [(T.Text, Type)] -> Maybe Type -> Maybe Type+resolveRetTypeAlias alias Nothing = Nothing+resolveRetTypeAlias alias (Just t) = Just (resolveTypeAlias alias t)+ genInit :: Field -> LT.Text genInit Field {..} = case fldDefault of Nothing -> ""@@ -115,13 +127,16 @@ [lt| public #{genType fldType} #{fldName}; |] -genException :: FilePath -> Decl -> IO()-genException packageName MPException {..} = do- LT.writeFile ( (formatClassName $ T.unpack excName) ++ ".java") [lt|-package #{packageName};+genException :: [(T.Text, Type)] -> Config -> Decl -> IO()+genException alias Config{..} MPException{..} = do+ LT.writeFile ( (formatClassName $ T.unpack excName) ++ ".java") $ templ configFilePath [lt|+package #{configPackage}; -public class #{formatClassNameT excName} #{params}{+import org.msgpack.MessagePack;+import org.msgpack.annotation.Message; +@Message+public class #{formatClassNameT excName} #{params}{ #{LT.concat $ map genDecl excFields} public #{formatClassNameT excName}() { #{LT.concat $ map genInit excFields}@@ -133,17 +148,19 @@ super = case excSuper of Just x -> [st|extends #{x}|] Nothing -> ""-genException _ _ = return ()+genException _ _ _ = return () genClient :: [(T.Text, Type)] -> Config -> Decl -> IO() genClient alias Config {..} MPService {..} = do let resolvedServiceMethods = map (resolveMethodAlias alias) serviceMethods- hashMapImport | not $ null [() | TMap _ _ <- map methodRetType resolvedServiceMethods ] = [lt|import java.util.HashMap;|]+ hashMapImport | not $ null [() | Just (TMap _ _) <- map methodRetType resolvedServiceMethods ] = [lt|import java.util.HashMap;|] | otherwise = ""- arrayListImport | not $ null [() | TList _ <- map methodRetType resolvedServiceMethods] = [lt|import java.util.ArrayList;|]+ arrayListImport | not $ null [() | Just (TList _) <- map methodRetType resolvedServiceMethods] = [lt|import java.util.ArrayList;|] | otherwise = ""+ dirName = joinPath $ map LT.unpack $ LT.split (== '.') $ LT.pack configPackage+ fileName = dirName ++ "/" ++ (T.unpack className) ++ ".java" - LT.writeFile (T.unpack className ++ ".java") $ templ configFilePath [lt|+ LT.writeFile fileName $ templ configFilePath [lt| package #{configPackage}; #{hashMapImport}@@ -173,13 +190,13 @@ let args = T.intercalate ", " $ map genArgs' methodArgs vals = T.intercalate ", " $ pack methodArgs genVal in case methodRetType of- TVoid -> [lt|+ Nothing -> [lt| public void #{methodName}(#{args}) { iface_.#{methodName}(#{vals}); } |]- _ -> [lt|- public #{genType methodRetType} #{methodName}(#{args}) {+ Just typ -> [lt|+ public #{genType typ} #{methodName}(#{args}) { return iface_.#{methodName}(#{vals}); } |]@@ -189,7 +206,7 @@ genSignature :: Method -> LT.Text genSignature Function {..} = - [lt| #{genType methodRetType} #{methodName}(#{args});+ [lt| #{genRetType methodRetType} #{methodName}(#{args}); |] where args = (T.intercalate ", " $ map genArgs' methodArgs)@@ -265,9 +282,11 @@ foldr1 (\t1 t2 -> [lt|Tuple<#{t1}, #{t2} >|]) $ map genWrapperType ts genType TObject = [lt|org.msgpack.type.Value|]-genType TVoid =- [lt|void|] +genRetType :: Maybe Type -> LT.Text+genRetType Nothing = [lt|void|]+genRetType (Just t) = genType t+ genTypeWithContext :: Spec -> Type -> LT.Text genTypeWithContext spec t = case t of (TUserDef className params) -> @@ -317,8 +336,8 @@ foldr1 (\t1 t2 -> [lt|Tuple<#{t1}, #{t2} >|]) $ map genWrapperType ts genWrapperType TObject = [lt|org.msgpack.type.Value|]-genWrapperType TVoid =- [lt|void|]+genWrapperType (TNullable typ) =+ genWrapperType typ templ :: FilePath -> LT.Text -> LT.Text templ filepath content = [lt|
Language/MessagePack/IDL/CodeGen/Perl.hs view
@@ -91,50 +91,8 @@ 1; |]- where- genMethodCall Function {..} =- let args = LT.intercalate ", " $ map arg methodArgs in- let vals = LT.concat $ map val methodArgs in- [lt|- #{genType methodRetType} #{methodName}(#{args}) {- return c_.call("#{methodName}"#{vals}).get<#{genType methodRetType} >();- }-|]- where- arg Field {..} = [lt|#{genType fldType} #{fldName}|]- val Field {..} = [lt|, #{fldName}|] - genMethodCall _ = ""- genClient _ = ""--genType :: Type -> LT.Text-genType (TInt sign bits) =- let base = if sign then "int" else "uint" :: LT.Text in- [lt|#{base}#{show bits}_t|]-genType (TFloat False) =- [lt|float|]-genType (TFloat True) =- [lt|double|]-genType TBool =- [lt|bool|]-genType TRaw =- [lt|std::string|]-genType TString =- [lt|std::string|]-genType (TList typ) =- [lt|std::vector<#{genType typ} >|]-genType (TMap typ1 typ2) =- [lt|std::map<#{genType typ1}, #{genType typ2} >|]-genType (TUserDef className params) =- [lt|#{className}|]-genType (TTuple ts) =- -- TODO: FIX- foldr1 (\t1 t2 -> [lt|std::pair<#{t1}, #{t2} >|]) $ map genType ts-genType TObject =- [lt|msgpack::object|]-genType TVoid =- [lt|void|] templ :: FilePath -> String -> String -> LT.Text -> LT.Text templ filepath once name content = [lt|
Language/MessagePack/IDL/CodeGen/Php.hs view
@@ -134,15 +134,15 @@ let args = LT.intercalate ", " $ map arg methodArgs in let sortedArgs = LT.intercalate ", " $ map (maybe undefined arg) $ sortField methodArgs in case methodRetType of- TVoid -> [lt|+ Nothing -> [lt| public function #{methodName}(#{args}) { $this->client->call("#{methodName}", array(#{sortedArgs})); } |]- _ -> [lt|+ Just typ -> [lt| public function #{methodName}(#{args}) { $ret = $this->client->call("#{methodName}", array(#{sortedArgs}));- $type_array = #{genTypeArray methodRetType};+ $type_array = #{genTypeArray typ}; return ObjectDecoder::decodeToObject($ret, $type_array); } |]
Language/MessagePack/IDL/CodeGen/Python.hs view
@@ -6,6 +6,7 @@ ) where import Data.List+import Data.Monoid import qualified Data.Text as T import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.IO as LT@@ -24,7 +25,7 @@ generate Config {..} spec = do createDirectoryIfMissing True (takeBaseName configFilePath); setCurrentDirectory (takeBaseName configFilePath);- LT.writeFile "__init__.py" $ [lt|+ LT.writeFile "__init__.py" $ templ configFilePath [lt| |] LT.writeFile "types.py" $ templ configFilePath [lt| import sys@@ -33,14 +34,14 @@ #{LT.concat $ map (genTypeDecl "") spec } |] - LT.writeFile "server.tmpl.py" $ [lt|+ LT.writeFile "server.tmpl.py" $ templ configFilePath [lt| import msgpackrpc from types import * # write your server here and change file name to server.py |] - LT.writeFile "client.py" [lt|+ LT.writeFile "client.py" $ templ configFilePath [lt| import msgpackrpc from types import * @@ -66,8 +67,7 @@ genMsg :: ToText a => a -> [Field] -> Bool -> LT.Text genMsg name flds isExc =- let- fs = map (maybe undefined fldName) $ sortField flds+ let fs = zipWith (\ix -> maybe ("_UNUSED" `mappend` T.pack (show ix)) fldName) [0 .. ] (sortField flds) in [lt| class #{name}#{e}: def __init__(self, #{LT.intercalate ", " $ map g fs}):@@ -108,15 +108,15 @@ |] where genMethodCall Function {..} =- let arg_list = map (maybe undefined fldName) $ sortField methodArgs+ let arg_list = zipWith (\ix -> maybe ("_UNUSED" `mappend` T.pack (show ix)) fldName) [0 .. ] $ sortField methodArgs args = LT.concat $ map (\x -> [lt|, #{x}|]) arg_list in case methodRetType of- TVoid -> [lt|+ Nothing -> [lt| def #{methodName} (self#{args}): self.client.call('#{methodName}'#{args}) |]- ts -> [lt|+ Just ts -> [lt| def #{methodName} (self#{args}): retval = self.client.call('#{methodName}'#{args}) return #{fromMsgpack ts "retval"}@@ -155,15 +155,13 @@ fromMsgpack (TTuple ts) name = let elems = map (f name) (zip [0..] ts) in- [lt| (#{LT.concat elems}) |]+ [lt| (#{LT.intercalate ", " elems}) |] where f :: T.Text -> (Integer, Type) -> LT.Text- f n (i, (TUserDef className _ )) = [lt|#{className}.from_msgpack(#{n}[#{show i}], |]- f n (i, _) = [lt|#{n}[#{show i}], |]+ f n (i, (TUserDef className _ )) = [lt|#{className}.from_msgpack(#{n}[#{show i}]) |]+ f n (i, _) = [lt|#{n}[#{show i}]|] fromMsgpack TObject name = [lt|#{name}|]-fromMsgpack TVoid _ = ""- templ :: FilePath -> LT.Text -> LT.Text templ filepath content = [lt|
Language/MessagePack/IDL/CodeGen/Ruby.hs view
@@ -31,14 +31,16 @@ let mods = LT.splitOn "::" $ LT.pack configModule - LT.writeFile "types.rb" $ [lt|+ LT.writeFile "types.rb" $ templ configFilePath [lt|+require 'rubygems' require 'msgpack/rpc' #{genModule mods $ LT.concat $ map (genTypeDecl "") spec } |] LT.writeFile ("client.rb") $ templ configFilePath [lt|+require 'rubygems' require 'msgpack/rpc'-require './types'+require File.join(File.dirname(__FILE__), 'types') #{genModule (snoc mods "Client") $ LT.concat $ map genClient spec}|] @@ -136,14 +138,13 @@ fromTuple (TTuple ts) name = let elems = map (f name) (zip [0..] ts) in- [lt| [#{LT.concat elems}] |]+ [lt| [#{LT.intercalate ", " elems}] |] where f :: T.Text -> (Integer, Type) -> LT.Text- f n (i, (TUserDef className _ )) = [lt|#{capitalizeT className}.from_tuple(#{n}[#{show i}], |]- f n (i, _) = [lt|#{n}[#{show i}], |]+ f n (i, (TUserDef className _ )) = [lt|#{capitalizeT className}.from_tuple(#{n}[#{show i}]) |]+ f n (i, _) = [lt|#{n}[#{show i}] |] fromTuple (TObject) name = [lt|#{name}|]-fromTuple TVoid _ = "" capitalizeT :: T.Text -> T.Text capitalizeT a = T.cons (toUpper $ T.head a) (T.tail a)@@ -260,8 +261,8 @@ #{capitalizeT t}.from_tuple(#{unpacked})|] genConvertingType _ _ _ = "" -genConvertingType' :: LT.Text -> LT.Text -> Type -> LT.Text-genConvertingType' unpacked v (TUserDef t p) = [lt|+genConvertingType' :: LT.Text -> LT.Text -> Maybe Type -> LT.Text+genConvertingType' unpacked v (Just (TUserDef t p)) = [lt| #{genConvertingType unpacked v (TUserDef t p)} |] genConvertingType' unpacked _ _ = [lt|#{unpacked}|]
Language/MessagePack/IDL/Syntax.hs view
@@ -46,7 +46,7 @@ = Function { methodInherit :: Bool , methodName :: T.Text- , methodRetType :: Type+ , methodRetType :: Maybe Type , methodArgs :: [Field] } | InheritName T.Text@@ -65,7 +65,6 @@ | TTuple [Type] | TUserDef T.Text [Type] | TObject- | TVoid deriving (Eq, Show, Data, Typeable) data Literal
exec/main.hs view
@@ -14,6 +14,7 @@ import qualified Language.MessagePack.IDL.CodeGen.Php as Php import qualified Language.MessagePack.IDL.CodeGen.Python as Python import qualified Language.MessagePack.IDL.CodeGen.Perl as Perl+import qualified Language.MessagePack.IDL.CodeGen.Erlang as Erlang import Paths_msgpack_idl @@ -49,6 +50,9 @@ { output_dir :: FilePath , namespace :: String , filepath :: FilePath }+ | Erlang+ { output_dir :: FilePath+ , filepath :: FilePath } deriving (Show, Eq, Data, Typeable) main :: IO ()@@ -88,6 +92,10 @@ , namespace = "msgpack" , filepath = def &= argPos 0 }+ , Erlang+ { output_dir = def+ , filepath = def &= argPos 0+ } ] &= help "MessagePack RPC IDL Compiler" &= summary ("mpidl " ++ showVersion version)@@ -124,3 +132,7 @@ Ruby {..} -> do Ruby.generate (Ruby.Config filepath modules) spec+ + Erlang {..} -> do+ Erlang.generate (Erlang.Config filepath) spec+
mpidl.peggy view
@@ -19,7 +19,7 @@ method :: Method = "inherit" identifier { InheritName $1 } / "inherit" "*" { InheritAll }- / "inherit"? ftype identifier "(" (field , ",") ")"+ / "inherit"? rtype identifier "(" (field , ",") ")" { Function (isJust $1) $3 $2 $4 } field :: Field@@ -30,6 +30,10 @@ = ftypeNN "?" { TNullable $1 } / ftypeNN +rtype :: Maybe Type+ = "void" { Nothing }+ / ftype { Just $1 }+ ftypeNN :: Type = "byte" { TInt True 8 } / "short" { TInt True 16 }@@ -44,7 +48,6 @@ / "bool" { TBool } / "raw" { TRaw } / "string" { TString }- / "void" { TVoid } / "object" { TObject } / "list" "<" ftype ">" { TList $1 }
msgpack-idl.cabal view
@@ -1,5 +1,5 @@ name: msgpack-idl-version: 0.2.0+version: 0.2.1 synopsis: An IDL Compiler for MessagePack description: An IDL Compiler for MessagePack <http://msgpack.org/> homepage: http://msgpack.org/@@ -21,12 +21,12 @@ library build-depends: base == 4.*- , bytestring == 0.9.*- , text == 0.11.*+ , bytestring >= 0.9+ , text >= 0.11 , shakespeare-text == 1.0.* , blaze-builder == 0.3.*- , template-haskell >= 2.5 && < 2.8- , containers == 0.4.*+ , template-haskell >= 2.5 && < 2.9+ , containers >= 0.4 , filepath >= 1.1 && < 1.4 , directory , msgpack == 0.7.*@@ -43,6 +43,7 @@ Language.MessagePack.IDL.CodeGen.Php Language.MessagePack.IDL.CodeGen.Python Language.MessagePack.IDL.CodeGen.Ruby+ Language.MessagePack.IDL.CodeGen.Erlang Language.MessagePack.IDL.Internal Language.MessagePack.IDL.Parser Language.MessagePack.IDL.Syntax@@ -52,8 +53,8 @@ main-is: main.hs build-depends: base == 4.*- , directory >= 1.0 && < 1.2- , cmdargs == 0.9.*+ , directory >= 1.0+ , cmdargs == 0.10.* , peggy == 0.3.* , msgpack-idl