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('@msgpackidl').
include("#{headerFile}").
#{LT.concat $ map genServer spec}
|]
LT.writeFile (name ++ "_client.erl") [lt|
% This file is automatically generated by msgpackidl.
module(#{name}_client).
author('@msgpackidl').
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) =
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 autogenerated from #{filepath}
#{content}|]