Permalink
Browse files

add Erlang prototype

  • Loading branch information...
1 parent 0e24690 commit 18fc5441a3fedf00c73b0ba8ac3d67e8701be7dc @kuenishi kuenishi committed Feb 22, 2012
Showing with 202 additions and 0 deletions.
  1. +189 −0 msgpack-idl/Language/MessagePack/IDL/CodeGen/Erlang.hs
  2. +12 −0 msgpack-idl/exec/main.hs
  3. +1 −0 msgpack-idl/msgpack-idl.cabal
@@ -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).
+
+#{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}").
+-behaviour(gen_msgpack_rpc_srv).
+
+-record(state, {}).
+#{LT.concat $ map genServer spec}
+|]
+
+ LT.writeFile (name ++ "_client.tmpl.erl") [lt|
+
+-module(#{name}_client).
+-author(@msgpack-idl).
+
+-include("#{headerFile}").
+#{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| : public std::exception|] else ""
+ f Field {..} = [lt|#{genType fldType} % #{fldName}|]
+
+sortField flds =
+ flip map [0 .. maximum $ [-1] ++ map fldId flds] $ \ix ->
+ find ((==ix). fldId) flds
+
+makeExport Function {..} = [lt|#{methodName}/#{show $ length methodArgs}|]
+makeExport _ = ""
+
+
+genServer :: Decl -> LT.Text
+genServer MPService {..} = [lt|
+
+-export([#{LT.intercalate ", " $ map makeExport serviceMethods}]).
+
+init(_Argv)-> {ok, #state{}}.
+
+% TODO enable #{serviceName}
+#{LT.concat $ map genSetMethod serviceMethods}
+
+|]
+ where
+ genSetMethod Function {..} =
+ let typs = map (genType . maybe TVoid 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}) -> #{genType methodRetType}.
+#{methodName}(#{LT.intercalate ", " args}) ->
+ Reply = ok, % write your code here
+ {reply, Reply}.
+|]
+-- rpc_server::add<#{sign} >("#{methodName}", pfi::lang::bind(&Impl::#{methodName}, static_cast<Impl*>(this)#{phs}));
+ genSetMethod _ = ""
+
+genServer _ = ""
+
+genClient :: Decl -> LT.Text
+genClient MPService {..} = [lt|
+
+% TODO: enable services #{serviceName}
+
+-export([#{LT.intercalate ", " $ map makeExport serviceMethods}]).
+
+% #{serviceName}(const std::string &host, uint64_t port, double timeout_sec)
+%
+
+#{LT.concat $ map genMethodCall serviceMethods}
+|]
+ where
+ genMethodCall Function {..} =
+ let typs = map (genType . maybe TVoid 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}) -> #{genType methodRetType}.
+#{methodName}(#{LT.intercalate ", " args}) ->
+ mprc::call(...).
+|]
+ 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 False) =
+ [lt|float()|]
+genType (TFloat True) =
+ [lt|double()|]
+genType TBool =
+ [lt|boolean()|]
+genType TRaw =
+ [lt|binary()|]
+genType TString =
+ [lt|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|std::pair<#{t1}, #{t2} >|]) $ map genType ts
+genType TObject =
+ [lt|term()|]
+genType TVoid =
+ [lt|void()|]
+
+templ :: FilePath -> String -> String -> LT.Text -> LT.Text
+templ filepath once name content = [lt|
+% This file is auto-generated from #{filepath}
+% *** DO NOT EDIT ***
+
+#{content}
+
+|]
@@ -14,6 +14,7 @@ import qualified Language.MessagePack.IDL.CodeGen.Java as Java
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 @@ data MPIDL
{ output_dir :: FilePath
, namespace :: String
, filepath :: FilePath }
+ | Erlang
+ { output_dir :: FilePath
+ , filepath :: FilePath }
deriving (Show, Eq, Data, Typeable)
main :: IO ()
@@ -88,6 +92,10 @@ main = do
, 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 @@ compile conf = do
Ruby {..} -> do
Ruby.generate (Ruby.Config filepath modules) spec
+
+ Erlang {..} -> do
+ Erlang.generate (Erlang.Config filepath) spec
+
@@ -43,6 +43,7 @@ library
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

0 comments on commit 18fc544

Please sign in to comment.