module Language.MessagePack.IDL.CodeGen.Cpp (
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
, configNameSpace :: String
, configPFICommon :: Bool
}
deriving (Show, Eq)
generate:: Config -> Spec -> IO ()
generate Config {..} spec = do
let name = takeBaseName configFilePath
once = map toUpper name
ns = LT.splitOn "::" $ LT.pack configNameSpace
typeHeader
| configPFICommon =
[lt|#include <msgpack.hpp>|]
| otherwise =
[lt|#include <msgpack.hpp>|]
serverHeader
| configPFICommon =
[lt|#include <pficommon/network/mprpc.h>
#include <pficommon/lang/bind.h>|]
| otherwise =
[lt|#include <msgpack/rpc/server.h>|]
clientHeader
| configPFICommon =
[lt|#include <pficommon/network/mprpc.h>|]
| otherwise =
[lt|#include <msgpack/rpc/client.h>|]
LT.writeFile (name ++ "_types.hpp") $ templ configFilePath ns once "TYPES" [lt|
#include <vector>
#include <map>
#include <string>
#include <stdexcept>
#include <stdint.h>
#{typeHeader}
#{genNameSpace ns $ LT.concat $ map (genTypeDecl name) spec }
|]
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") $ templ configFilePath (snoc ns "client") once "CLIENT" [lt|
#include "#{name}_types.hpp"
#{clientHeader}
#{genNameSpace (snoc ns "client") $ LT.concat $ map (genClient configPFICommon) spec}
|]
genTypeDecl :: String -> Decl -> LT.Text
genTypeDecl _ MPMessage {..} =
genMsg msgName msgFields False
genTypeDecl _ MPException {..} =
genMsg excName excFields True
genTypeDecl _ MPType { .. } =
[lt|
typedef #{genType tyType} #{tyName};
|]
genTypeDecl _ _ = ""
genMsg name flds isExc =
let fields = map f flds
fs = map (maybe undefined fldName) $ sortField flds
in [lt|
struct #{name}#{e} {
public:
#{destructor}
MSGPACK_DEFINE(#{T.intercalate ", " fs});
#{LT.concat fields}
};
|]
where
e = if isExc then [lt| : public std::exception|] else ""
destructor = if isExc then [lt|~#{name}() throw() {}
|] else ""
f Field {..} = [lt|
#{genType fldType} #{fldName};|]
sortField flds =
flip map [0 .. maximum $ [1] ++ map fldId flds] $ \ix ->
find ((==ix). fldId) flds
genServer :: Bool -> Decl -> LT.Text
genServer False MPService {..} = [lt|
template <class Impl>
class #{serviceName} : public msgpack::rpc::server::base {
public:
void dispatch(msgpack::rpc::request req) {
try {
std::string method;
req.method().convert(&method);
#{LT.concat $ map genMethodDispatch serviceMethods}
} catch (const msgpack::type_error& e) {
req.error(msgpack::rpc::ARGUMENT_ERROR);
} catch (const std::exception& e) {
req.error(std::string(e.what()));
}
}
};
|]
where
genMethodDispatch Function {..} =
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<#{genRetType methodRetType} >(static_cast<Impl*>(this)->#{methodName}());
return;
}
|]
_ -> [lt|
if (method == "#{methodName}") {
msgpack::type::tuple<#{LT.intercalate ", " typs} > params;
req.params().convert(¶ms);
req.result<#{genRetType methodRetType} >(static_cast<Impl*>(this)->#{methodName}(#{LT.intercalate ", " params}));
return;
}
|]
where
g fld = [lt|params.get<#{show $ fldId fld}>()|]
genMethodDispatch _ = ""
genServer True MPService {..} = [lt|
template <class Impl>
class #{serviceName} : public pfi::network::mprpc::rpc_server {
public:
#{serviceName}(double timeout_sec): rpc_server(timeout_sec) {
#{LT.concat $ map genSetMethod serviceMethods}
}
};
|]
where
genSetMethod Function {..} =
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}));|]
genSetMethod _ = ""
genServer _ _ = ""
genClient :: Bool -> Decl -> LT.Text
genClient False MPService {..} = [lt|
class #{serviceName} {
public:
#{serviceName}(const std::string &host, uint64_t port)
: c_(host, port) {}
#{LT.concat $ map genMethodCall serviceMethods}
private:
msgpack::rpc::client c_;
};
|]
where
genMethodCall Function {..} =
let args = LT.intercalate ", " $ map arg methodArgs in
let vals = LT.concat $ map val methodArgs in
case methodRetType of
Nothing -> [lt|
void #{methodName}(#{args}) {
c_.call("#{methodName}"#{vals});
}
|]
Just typ -> [lt|
#{genType typ} #{methodName}(#{args}) {
return c_.call("#{methodName}"#{vals}).get<#{genType typ} >();
}
|]
where
arg Field {..} = [lt|#{genType fldType} #{fldName}|]
val Field {..} = [lt|, #{fldName}|]
genMethodCall _ = ""
genClient True MPService {..} = [lt|
class #{serviceName} : public pfi::network::mprpc::rpc_client {
public:
#{serviceName}(const std::string &host, uint64_t port, double timeout_sec)
: rpc_client(host, port, timeout_sec) {}
#{LT.concat $ map genMethodCall serviceMethods}
private:
};
|]
where
genMethodCall Function {..} =
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
Nothing -> [lt|
void #{methodName}(#{args}) {
call<#{sign}>("#{methodName}")(#{vals});
}
|]
Just t -> [lt|
#{genType t} #{methodName}(#{args}) {
return call<#{sign}>("#{methodName}")(#{vals});
}
|]
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) =
foldr1 (\t1 t2 -> [lt|std::pair<#{t1}, #{t2} >|]) $ map genType ts
genType TObject =
[lt|msgpack::object|]
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 autogenerated from #{filepath}
// *** DO NOT EDIT ***
#ifndef #{namespace}_#{once}_#{name}_HPP_
#define #{namespace}_#{once}_#{name}_HPP_
#{content}
#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
where
f [] = [lt|#{content}|]
f (n:ns) = [lt|
namespace #{n} {
#{f ns}
} // namespace #{n}
|]
snoc xs x = xs ++ [x]