msgpack-idl 0.1.0 → 0.2.0

raw patch · 11 files changed

+513/−342 lines, 11 filesdep +hspecdep ~directorydep ~filepathdep ~shakespeare-textPVP ok

version bump matches the API change (PVP)

Dependencies added: hspec

Dependency ranges changed: directory, filepath, shakespeare-text

API changes (from Hackage documentation)

Files

• Language/MessagePack/IDL/CodeGen/Haskell.hs +13/−12
• Language/MessagePack/IDL/CodeGen/Java.hs +16/−2
• Language/MessagePack/IDL/CodeGen/Py.hs +0/−148
• Language/MessagePack/IDL/CodeGen/Python.hs +174/−0
• Language/MessagePack/IDL/CodeGen/Ruby.hs +104/−25
• Language/MessagePack/IDL/Internal.hs +14/−0
• Language/MessagePack/IDL/Syntax.hs +7/−5
• exec/Main.hs +0/−118
• exec/main.hs +126/−0
• msgpack-idl.cabal +41/−32
• test/test.hs +18/−0

@@ -3,25 +3,26 @@ {-# LANGUAGE RecordWildCards #-}  module Language.MessagePack.IDL.CodeGen.Haskell (+  Config(..),   generate,   ) where  import Data.Char import Data.Monoid import qualified Data.Text as T-import qualified Data.Text.IO as T import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.IO as LT--- import Language.Haskell.TH as TH import Text.Shakespeare.Text  import Language.MessagePack.IDL.Syntax as MP -generate = undefined+data Config+  = Config+    { configFilePath :: FilePath+    } -{--generate :: FilePath -> String -> Spec -> IO ()-generate filename name spec = do+generate :: Config -> Spec -> IO ()+generate Config {..} spec = do   LT.writeFile "Types.hs" [lt| {-# LANGUAGE TemplateHaskell #-} @@ -55,7 +56,7 @@ |]  genClient :: Decl -> LT.Text-genClient Service {..} =+genClient MPService {..} =   [lt| newtype #{monadName} m a   = #{monadName} { un#{monadName} :: StateT () m a }@@ -76,7 +77,7 @@ genClient _ = ""  genTypeDecl :: Decl -> LT.Text-genTypeDecl Message {..} =+genTypeDecl MPMessage {..} =   let mems = LT.intercalate "\n  , " $ map f msgFields in   [lt| data #{dataName}@@ -112,10 +113,12 @@   [lt|[#{genType typ}]|] genType (TMap typ1 typ2) =   [lt|Map (#{genType typ1}) (#{genType typ2})|]-genType (TClass name) =-  [lt|#{classize name}|] genType (TTuple typs) =   [lt|(#{LT.intercalate ", " $ map genType typs})|]+genType (TUserDef name params) =+  [lt|#{classize name}|]+genType (TObject) =+  undefined genType (TVoid) =   [lt|()|] @@ -204,6 +207,4 @@  uncapital (c:cs) = toLower c : cs uncapital cs = cs--}- -}

@@ -60,9 +60,17 @@ genStruct alias packageName 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 = ""+   LT.writeFile ( (formatClassName $ T.unpack msgName) ++ ".java") [lt| package #{packageName}; +#{hashMapImport}+#{arrayListImport}+ public class #{formatClassNameT msgName} #{params} {  #{LT.concat $ map genDecl resolvedMsgFields}@@ -130,10 +138,16 @@ genClient :: [(T.Text, Type)] -> Config -> Decl -> IO() genClient alias Config {..} MPService {..} = do    let resolvedServiceMethods = map (resolveMethodAlias alias) serviceMethods-  LT.writeFile (T.unpack className ++ ".java") $ templ configFilePath [lt|+      hashMapImport | not $ null [() | TMap _ _ <- map methodRetType resolvedServiceMethods ] = [lt|import java.util.HashMap;|]+                    | otherwise = ""+      arrayListImport | not $ null [() | TList _ <- map methodRetType resolvedServiceMethods] = [lt|import java.util.ArrayList;|]+                      | otherwise = "" +  LT.writeFile (T.unpack className ++ ".java") $ templ configFilePath [lt| package #{configPackage};-import java.util.ArrayList;++#{hashMapImport}+#{arrayListImport} import org.msgpack.rpc.Client; import org.msgpack.rpc.loop.EventLoop; 

@@ -1,148 +0,0 @@-{-# LANGUAGE QuasiQuotes, RecordWildCards, OverloadedStrings #-}--module Language.MessagePack.IDL.CodeGen.Py (-  Config(..),-  generate,-  ) 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-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--      typeHeader = [lt|import msgpack|]-      serverHeader = [lt|import msgpackrpc|]-      clientHeader = [lt|import msgpackrpc|]-  -  LT.writeFile (name ++ "_types.py") $ templ "TYPES" [lt|-import sys-#{typeHeader}--#{LT.concat $ map (genTypeDecl name) spec }-|]--  LT.writeFile (name ++ "_server.py") $ templ "SERVER" [lt|-import #{name}_types-#{serverHeader}-|]--  LT.writeFile (name ++ "_client.py") [lt|-import #{name}_types-#{clientHeader}-#{LT.concat $ map (genClient) spec}-|]--genTypeDecl :: String -> Decl -> LT.Text--genTypeDecl _ MPMessage {..} =-  genMsg msgName msgFields False--genTypeDecl _ MPException {..} =-  genMsg excName excFields True--genTypeDecl _ _ = ""--genMsg name flds isExc =-  let fields = map f flds-      types = map typ flds-      fs = map (maybe undefined fldName) $ sortField flds-  in [lt|-class #{name}#{e}:--  def __init__(self#{LT.concat $ map g fs}):-#{LT.concat fields}-  def to_array(self):-    variables = []-#{LT.concat types}-    return variables-|]--  where-    e = if isExc then [lt|(Exception)|] else ""-    f Field {..} = [lt|    self.#{fldName} = #{fldName}-|]-    typ Field {..} = let selfName = "self." `mappend` fldName-                     in [lt|    variables.append(#{genType fldType selfName})-|]-    g str = [lt|, #{str}|]--sortField flds =-  flip map [0 .. maximum $ [-1] ++ map fldId flds] $ \ix ->-  find ((==ix). fldId) flds--genClient :: Decl -> LT.Text-genClient MPService {..} = [lt|-class #{serviceName}:-  def __init__ (self, host, port):-    address = msgpackrpc.Address(host, port)-    self.client = msgpackrpc.Client(address)-#{LT.concat $ map genMethodCall serviceMethods}-|]-  where-  genMethodCall Function {..} =-    let arg_list = map (maybe undefined fldName) $ sortField methodArgs-        args = LT.concat $ map arg arg_list-        to_arrays = LT.concat $ map to_array methodArgs in-    case methodRetType of-      TVoid -> [lt|-  def #{methodName} (self#{args}):-#{to_arrays}-    self.client.call('#{methodName}'#{args})-|]-      _ -> [lt|-  def #{methodName} (self#{args}):-#{to_arrays}-    return self.client.call('#{methodName}'#{args})-|]-    where-      arg str = [lt|, #{str}|]-      to_array Field {..} = [lt|    #{fldName} = #{genType fldType fldName}-|]--  genMethodCall _ = ""--genClient _ = ""--genType :: Type -> T.Text -> LT.Text-genType (TInt sign bits) name = [lt|#{name}|]-genType (TFloat False) name = [lt|#{name}|]-genType (TFloat True) name = [lt|#{name}|]-genType TBool name = [lt|#{name}|]-genType TRaw name = [lt|#{name}|]-genType TString name = [lt|#{name}|]-genType (TList typ) name =-  [lt|[#{genType typ "elem"} for elem in #{name}]|]-genType (TMap typ1 typ2) name =-  [lt|{#{genType typ1 "k"} : #{genType typ2 "v"} for k,v in #{name}.items()}|]-genType (TUserDef className params) name = [lt|#{name}.to_array()|]-genType (TTuple ts) name = [lt|#{name}.to_array()|]-  -- TODO: FIX-  -- foldr1 (\t1 t2 -> [lt|std::pair<#{t1}, #{t2} >|]) $ map genType ts-genType TObject name = [lt|#{name}.to_array()|]-genType TVoid name = ""---templ :: FilePath -> LT.Text -> LT.Text-templ filepath content = [lt|-#/usr/bin/python-# -*- coding:utf-8 -*---# This file is auto-generated from #{filepath}-# *** DO NOT EDIT ***--#{content}-|]

@@ -0,0 +1,174 @@+{-# LANGUAGE QuasiQuotes, RecordWildCards, OverloadedStrings #-}++module Language.MessagePack.IDL.CodeGen.Python (+  Config(..),+  generate,+  ) where++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 System.Directory++import Language.MessagePack.IDL.Syntax++data Config+  = Config+    { configFilePath :: FilePath }+  deriving (Show, Eq)++generate:: Config -> Spec -> IO ()+generate Config {..} spec = do+  createDirectoryIfMissing True (takeBaseName configFilePath);+  setCurrentDirectory (takeBaseName configFilePath);+  LT.writeFile "__init__.py" $ [lt|+|]+  LT.writeFile "types.py" $ templ configFilePath [lt|+import sys+import msgpack++#{LT.concat $ map (genTypeDecl "") spec }+|]++  LT.writeFile "server.tmpl.py" $ [lt|+import msgpackrpc+from types import *+# write your server here and change file name to server.py++|]++  LT.writeFile "client.py" [lt|+import msgpackrpc+from types import *++#{LT.concat $ map (genClient) spec}+|]++genTypeDecl :: String -> Decl -> LT.Text++genTypeDecl _ MPType {..} = [lt|+class #{tyName}:+  @staticmethod+  def from_msgpack(arg):+    return #{fromMsgpack tyType "arg"}+|]++genTypeDecl _ MPMessage {..} =+  genMsg msgName msgFields False++genTypeDecl _ MPException {..} =+  genMsg excName excFields True++genTypeDecl _ _ = ""++genMsg :: ToText a => a -> [Field] -> Bool -> LT.Text+genMsg name flds isExc =+  let+      fs = map (maybe undefined fldName) $ sortField flds+  in [lt|+class #{name}#{e}:+  def __init__(self, #{LT.intercalate ", " $ map g fs}):+#{LT.concat $ map f flds}+  def to_msgpack(self):+    return (#{LT.concat $ map typ flds}+      )++  @staticmethod+  def from_msgpack(arg):+    return #{name}(+      #{LT.intercalate ",\n      " $ map make_arg flds})+|]++  where+    e = if isExc then [lt|(Exception)|] else ""+    f Field {..} = [lt|    self.#{fldName} = #{fldName}+|]+    typ Field {..} = [lt|+      self.#{fldName},|]+    make_arg Field {..} =+      let fldId_str = T.concat $ map T.pack ["arg[", (show fldId), "]"] in+      [lt|#{fromMsgpack fldType fldId_str}|]+    g str = [lt|#{str}|]++sortField :: [Field] -> [Maybe Field]+sortField flds =+  flip map [0 .. maximum $ [-1] ++ map fldId flds] $ \ix ->+  find ((==ix). fldId) flds++genClient :: Decl -> LT.Text+genClient MPService {..} = [lt|+class #{serviceName}:+  def __init__ (self, host, port):+    address = msgpackrpc.Address(host, port)+    self.client = msgpackrpc.Client(address)+#{LT.concat $ map genMethodCall serviceMethods}+|]+  where+  genMethodCall Function {..} =+    let arg_list = map (maybe undefined fldName) $ sortField methodArgs+        args = LT.concat $ map (\x -> [lt|, #{x}|]) arg_list+    in+    case methodRetType of+      TVoid -> [lt|+  def #{methodName} (self#{args}):+    self.client.call('#{methodName}'#{args})+|]+      ts -> [lt|+  def #{methodName} (self#{args}):+    retval = self.client.call('#{methodName}'#{args})+    return #{fromMsgpack ts "retval"}+|]++  genMethodCall _ = ""++genClient _ = ""++sanitize :: Char -> Char+sanitize '[' = '_'+sanitize ']' = '_'+sanitize c = c++fromMsgpack :: Type -> T.Text -> LT.Text+fromMsgpack (TNullable t) name = fromMsgpack t name+fromMsgpack (TInt _ _) name = [lt|#{name}|]+fromMsgpack (TFloat False) name = [lt|#{name}|]+fromMsgpack (TFloat True) name = [lt|#{name}|]+fromMsgpack TBool name = [lt|#{name}|]+fromMsgpack TRaw name = [lt|#{name}|]+fromMsgpack TString name = [lt|#{name}|]+fromMsgpack (TList typ) name =+  let+    varname = T.append (T.pack "elem_") (T.map sanitize name) in+  [lt|[#{fromMsgpack typ varname} for #{varname} in #{name}]|]++fromMsgpack (TMap typ1 typ2) name =+  let+    keyname = T.append (T.pack "k_" ) $ T.map sanitize name+    valname = T.append (T.pack "v_" ) $ T.map sanitize name+  in+  [lt|{#{fromMsgpack typ1 keyname} : #{fromMsgpack typ2 valname} for #{keyname},#{valname} in #{name}.items()}|]++fromMsgpack (TUserDef className _) name = [lt|#{className}.from_msgpack(#{name})|]+            +fromMsgpack (TTuple ts) name =+            let elems = map (f name) (zip [0..] ts) in+            [lt| (#{LT.concat 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}], |]++fromMsgpack TObject name = [lt|#{name}|]+fromMsgpack TVoid _ = ""+++templ :: FilePath -> LT.Text -> LT.Text+templ filepath content = [lt|+# This file is auto-generated from #{filepath}+# *** DO NOT EDIT ***++#{content}+|]

@@ -13,6 +13,7 @@ import qualified Data.Text.Lazy.IO as LT import System.FilePath import Text.Shakespeare.Text+import System.Directory  import Language.MessagePack.IDL.Syntax @@ -25,21 +26,34 @@  generate:: Config -> Spec -> IO () generate Config {..} spec = do-  let name = takeBaseName configFilePath-      once = map toUpper name-      mods = LT.splitOn "::" $ LT.pack configModule-  LT.writeFile (name ++ "_types.rb") $ templ configFilePath [lt|+  createDirectoryIfMissing True (takeBaseName configFilePath);+  setCurrentDirectory (takeBaseName configFilePath);+  let+        mods = LT.splitOn "::" $ LT.pack configModule+        +  LT.writeFile "types.rb" $ [lt| require 'msgpack/rpc'--#{genModule mods $ LT.concat $ map (genTypeDecl name) spec }|]+#{genModule mods $ LT.concat $ map (genTypeDecl "") spec }+|]   -  LT.writeFile (name ++ "_client.rb") $ templ configFilePath [lt|+  LT.writeFile ("client.rb") $ templ configFilePath [lt| require 'msgpack/rpc'-require './#{name}_types'+require './types'  #{genModule (snoc mods "Client") $ LT.concat $ map genClient spec}|]  genTypeDecl :: String -> Decl -> LT.Text+genTypeDecl _ MPType {..} = [lt|+class #{capitalizeT tyName}+  def #{capitalizeT tyName}.from_tuple(tuple)+    #{fromTuple tyType "tuple"}+  end+  def to_tuple(o)+    o+  end+end+|]+ genTypeDecl _ MPMessage {..} =   genMsg msgName msgFields False @@ -48,31 +62,93 @@    genTypeDecl _ _ = "" +genMsg :: T.Text -> [Field] -> Bool -> LT.Text genMsg name flds isExc = [lt| class #{capitalizeT name}#{deriveError}+  def initialize(#{T.intercalate ", " fs})+    #{LT.intercalate "\n    " $ map makeSubst fs}+  end+  def to_tuple    +    [#{LT.intercalate ",\n     " $ map make_tuple flds}]+  end   def to_msgpack(out = '')-    [#{afs}].to_msgpack(out)+    to_tuple.to_msgpack(out)   end--  def from_unpacked(unpacked)-    #{afs} = unpacked+  def #{capitalizeT name}.from_tuple(tuple)+    #{capitalizeT name}.new(+      #{LT.intercalate ",\n      " $ map make_arg flds}+    )   end--#{indent 2 $ LT.concat writers}- #{indent 2 $ genAccessors sorted_flds} end-|]+|]-- #{indent 2 $ LT.concat writers}   where     sorted_flds = sortField flds     fs = map (maybe undefined fldName) sorted_flds-    writers = map (maybe undefined genAttrWriter) sorted_flds-    afs = T.intercalate ", " $ map (mappend "@") fs+--    afs = LT.intercalate ",\n     " $ map make_tuple flds+    make_tuple Field {..} = +      [lt|#{toTuple True fldType fldName}|]     deriveError = if isExc then [lt| < StandardError|] else ""+    make_arg Field {..} =+      let fldIdstr = T.concat $ map T.pack ["tuple[", (show fldId), "]"]+      in [lt|#{fromTuple fldType fldIdstr}|] +makeSubst :: T.Text -> LT.Text+makeSubst fld = [lt| @#{fld} = #{fld} |]++toTuple :: Bool -> Type -> T.Text -> LT.Text+toTuple _ (TTuple ts) name = +  let elems = map (f name) (zip [0..] ts) in+  [lt| [#{LT.concat elems}] |]+    where+      f :: T.Text -> (Integer, Type) -> LT.Text+      f n (i, (TUserDef _fg _ )) = [lt|#{n}[#{show i}].to_tuple}, |]+      f n (i, _) = [lt|#{n}[#{show i}], |]++toTuple True t name = [lt|@#{toTuple False t name}|]+toTuple _ (TNullable t) name = [lt|#{toTuple False t name}|]+toTuple _ (TInt _ _)    name = [lt|#{name}|]+toTuple _ (TFloat _)    name = [lt|#{name}|]+toTuple _ TBool         name = [lt|#{name}|]+toTuple _ TRaw          name = [lt|#{name}|]+toTuple _ TString       name = [lt|#{name}|]+toTuple _ (TList typ)   name = [lt|#{name}.map {|x| #{toTuple False typ "x"}}|]+toTuple _ (TMap typ1 typ2) name =+  [lt|#{name}.each_with_object({}) {|(k,v),h| h[#{toTuple False typ1 "k"}] = #{toTuple False typ2 "v"}}|]+toTuple _ (TUserDef _ _) name = [lt|#{name}.to_tuple|]++toTuple _ _ _ = ""++fromTuple :: Type -> T.Text -> LT.Text+fromTuple (TNullable t) name = [lt|#{fromTuple t name}|]+fromTuple (TInt _ _) name    = [lt|#{name}|]+fromTuple (TFloat _) name    = [lt|#{name}|]+fromTuple TBool name         = [lt|#{name}|]+fromTuple TRaw name          = [lt|#{name}|]+fromTuple TString name       = [lt|#{name}|]+fromTuple (TList typ) name =+  [lt|#{name}.map { |x| #{fromTuple typ "x"} }|]+  +fromTuple (TMap typ1 typ2) name =+  [lt|#{name}.each_with_object({}) {|(k,v),h| h[#{fromTuple typ1 "k"}] = #{fromTuple typ2 "v"} }|]++fromTuple (TUserDef className _) name = [lt|#{capitalizeT className}.from_tuple(#{name})|]++fromTuple (TTuple ts) name =+  let elems = map (f name) (zip [0..] ts) in+  [lt| [#{LT.concat 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}], |]++fromTuple (TObject) name = [lt|#{name}|]+fromTuple TVoid _ = ""+ capitalizeT :: T.Text -> T.Text capitalizeT a = T.cons (toUpper $ T.head a) (T.tail a) +sortField :: [Field] -> [Maybe Field] sortField flds =   flip map [0 .. maximum $ [-1] ++ map fldId flds] $ \ix -> find ((==ix). fldId) flds @@ -84,13 +160,15 @@   LT.dropAround (== '\n') $ LT.unlines $ map (indentLine ind) lines  indentLine :: Int -> LT.Text -> LT.Text-indentLine ind "" = ""+indentLine _ "" = "" indentLine ind line = mappend (LT.pack $ replicate ind ' ') line +{- extractJust :: [Maybe a] -> [a] extractJust [] = [] extractJust (Nothing:xs) = extractJust xs extractJust (Just v:xs)  = v : extractJust xs+-}  data AccessorType = Read | ReadWrite deriving Eq @@ -118,6 +196,7 @@  -- TODO: Check when val is not null with TNullable -- TODO: Write single precision value on TFloat False+{- genAttrWriter :: Field -> LT.Text genAttrWriter Field {..} = genAttrWriter' fldType fldName @@ -142,7 +221,6 @@     convert from to (TUserDef t p) =         genConvertingType from to (TUserDef t p)     convert from to _ = [lt|#{to} = #{from}|]- genAttrWriter' (TUserDef name types) n = [lt| def #{n}=(val) #{indent 2 $ convert "val" atn (TUserDef name types)}@@ -152,9 +230,10 @@     atn = [lt|@#{n}|]     convert from to (TUserDef t p) =         genConvertingType from to (TUserDef t p)- genAttrWriter' _ _ = ""+-} + genClient :: Decl -> LT.Text genClient MPService {..} = [lt| class #{capitalizeT serviceName}@@ -177,15 +256,14 @@ genClient _ = ""  genConvertingType :: LT.Text -> LT.Text -> Type -> LT.Text-genConvertingType unpacked v (TUserDef t _) = [lt|-#{v} = #{capitalizeT t}.new-#{v}.from_unpacked(#{unpacked})|]+genConvertingType unpacked _ (TUserDef t _) = [lt|+#{capitalizeT t}.from_tuple(#{unpacked})|] genConvertingType _ _ _ = ""  genConvertingType' :: LT.Text -> LT.Text -> Type -> LT.Text genConvertingType' unpacked v (TUserDef t p) = [lt| #{genConvertingType unpacked v (TUserDef t p)}-return v|]+|] genConvertingType' unpacked _ _ = [lt|#{unpacked}|]  templ :: FilePath -> LT.Text -> LT.Text@@ -202,4 +280,5 @@ #{f ns} end|] +snoc :: [a] -> a -> [a] snoc xs x = xs ++ [x]

@@ -0,0 +1,14 @@+module Language.MessagePack.IDL.Internal (+  withDirectory+  ) where++import Control.Exception+import System.Directory++withDirectory :: FilePath -> IO a -> IO a+withDirectory dir m = do+  createDirectoryIfMissing True dir+  bracket+    getCurrentDirectory+    setCurrentDirectory+    (\_ -> setCurrentDirectory dir >> m)

@@ -1,5 +1,7 @@+{-# LANGUAGE DeriveDataTypeable #-} module Language.MessagePack.IDL.Syntax where +import Data.Data import qualified Data.Text as T  type Spec = [Decl]@@ -29,7 +31,7 @@     , serviceVersion :: Maybe Int     , serviceMethods :: [Method]     }-  deriving (Eq, Show)+  deriving (Eq, Show, Data, Typeable)  data Field   = Field@@ -38,7 +40,7 @@     , fldName :: T.Text     , fldDefault :: Maybe Literal     }-  deriving (Eq, Show)+  deriving (Eq, Show, Data, Typeable)  data Method   = Function@@ -49,7 +51,7 @@     }   | InheritName T.Text   | InheritAll-  deriving (Eq, Show)+  deriving (Eq, Show, Data, Typeable)  data Type   = TInt Bool Int -- signed? bits@@ -64,7 +66,7 @@   | TUserDef T.Text [Type]   | TObject   | TVoid-  deriving (Eq, Show)+  deriving (Eq, Show, Data, Typeable)  data Literal   = LInt Int@@ -72,4 +74,4 @@   | LBool Bool   | LNull   | LString T.Text-  deriving (Eq, Show)+  deriving (Eq, Show, Data, Typeable)

@@ -1,118 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE RecordWildCards #-}--import Control.Exception-import Data.Version-import System.Console.CmdArgs-import System.Directory-import Text.Peggy--import Language.MessagePack.IDL-import qualified Language.MessagePack.IDL.CodeGen.Haskell as Haskell-import qualified Language.MessagePack.IDL.CodeGen.Cpp as Cpp-import qualified Language.MessagePack.IDL.CodeGen.Ruby as Ruby-import qualified Language.MessagePack.IDL.CodeGen.Java as Java-import qualified Language.MessagePack.IDL.CodeGen.Php as Php-import qualified Language.MessagePack.IDL.CodeGen.Py as Py-import qualified Language.MessagePack.IDL.CodeGen.Perl as Perl--import Paths_msgpack_idl--data MPIDL-  = Haskell-  | Cpp-    { output_dir :: FilePath-    , namespace :: String-    , pficommon :: Bool-    , filepath :: FilePath }-  | Ruby-    { output_dir :: FilePath-    , modules :: String-    , filepath :: FilePath }-  | Java-    { output_dir :: FilePath-    , package :: String-    , filepath :: FilePath-    }-  | Php-    { output_dir :: FilePath-    , filepath :: FilePath-    }-  | Py-    { output_dir :: FilePath-     , filepath :: FilePath-    }-  | Perl-    { output_dir :: FilePath-    , namespace :: String-    , filepath :: FilePath }-  deriving (Show, Eq, Data, Typeable)--main :: IO ()-main = do-  conf <- cmdArgs $-    modes [ Haskell-          , Cpp { output_dir = def-                , namespace = "msgpack"-                , pficommon = False-                , filepath = def &= argPos 0-                }-          , Ruby { output_dir = def-                 , modules = "MessagePack"-                 , filepath = def &= argPos 0-                 }-          , Java { output_dir = def-                 , package = "msgpack"-                 , filepath = def &= argPos 0-                 }-          , Php { output_dir = def-                , filepath = def &= argPos 0-                }-          , Py  { output_dir = def-                }-          , Perl { output_dir = def-                , namespace = "msgpack"-                , filepath = def &= argPos 0-                }-          ]-    &= help "MessagePack RPC IDL Compiler"-    &= summary ("mpidl " ++ showVersion version)--  compile conf--compile :: MPIDL -> IO ()-compile conf = do-  espec <- parseFile idl (filepath conf)-  case espec of-    Left err -> do-      print err-    Right spec -> do-      print spec-      case conf of-        Cpp {..} -> do-          withDirectory output_dir $ do-            Cpp.generate (Cpp.Config filepath namespace pficommon) spec-        -        Java {..} -> do-          withDirectory (output_dir ++ "/" ++ package) $ do-            Java.generate (Java.Config filepath package) spec--        Php {..} -> do-          withDirectory (output_dir) $ do-            Php.generate (Php.Config filepath) spec- -        Ruby {..} -> do-          withDirectory (output_dir) $ do-            Ruby.generate (Ruby.Config filepath modules) spec--        Perl {..} -> do-          withDirectory output_dir $ do-            Perl.generate (Perl.Config filepath namespace) spec--withDirectory :: FilePath -> IO a -> IO a-withDirectory dir m = do-  createDirectoryIfMissing True dir-  bracket-    getCurrentDirectory-    setCurrentDirectory-    (\_ -> setCurrentDirectory dir >> m)

@@ -0,0 +1,126 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RecordWildCards #-}++import Data.Version+import System.Console.CmdArgs+import Text.Peggy++import Language.MessagePack.IDL+import Language.MessagePack.IDL.Internal+import qualified Language.MessagePack.IDL.CodeGen.Haskell as Haskell+import qualified Language.MessagePack.IDL.CodeGen.Cpp as Cpp+import qualified Language.MessagePack.IDL.CodeGen.Ruby as Ruby+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 Paths_msgpack_idl++data MPIDL+  = Haskell+    { output_dir :: FilePath+    , module_name :: String+    , filepath :: FilePath+    }+  | Cpp+    { output_dir :: FilePath+    , namespace :: String+    , pficommon :: Bool+    , filepath :: FilePath }+  | Ruby+    { output_dir :: FilePath+    , modules :: String+    , filepath :: FilePath }+  | Java+    { output_dir :: FilePath+    , package :: String+    , filepath :: FilePath+    }+  | Php+    { output_dir :: FilePath+    , filepath :: FilePath+    }+  | Python+    { output_dir :: FilePath+    , filepath :: FilePath+    }+  | Perl+    { output_dir :: FilePath+    , namespace :: String+    , filepath :: FilePath }+  deriving (Show, Eq, Data, Typeable)++main :: IO ()+main = do+  conf <- cmdArgs $+    modes [ Haskell+            { output_dir = def+            , module_name = ""+            , filepath = def &= argPos 0+            }+          , Cpp+            { output_dir = def+            , namespace = "msgpack"+            , pficommon = False+            , filepath = def &= argPos 0+            }+          , Ruby+            { output_dir = def+            , modules = "MessagePack"+            , filepath = def &= argPos 0+            }+          , Java+            { output_dir = def+            , package = "msgpack"+            , filepath = def &= argPos 0+            }+          , Php+            { output_dir = def+            , filepath = def &= argPos 0+            }+          , Python+            { output_dir = def+            , filepath = def &= argPos 0+            }+          , Perl+            { output_dir = def+            , namespace = "msgpack"+            , filepath = def &= argPos 0+            }+          ]+    &= help "MessagePack RPC IDL Compiler"+    &= summary ("mpidl " ++ showVersion version)++  compile conf++compile :: MPIDL -> IO ()+compile conf = do+  espec <- parseFile idl (filepath conf)+  case espec of+    Left err -> do+      print err+    Right spec -> do+      print spec+      withDirectory (output_dir conf) $ do+        case conf of+          Cpp {..} -> do+            Cpp.generate (Cpp.Config filepath namespace pficommon) spec+          +          Haskell {..} -> do+            Haskell.generate (Haskell.Config filepath) spec+        +          Java {..} -> do+            Java.generate (Java.Config filepath package) spec++          Perl {..} -> do+            Perl.generate (Perl.Config filepath namespace) spec++          Php {..} -> do+            Php.generate (Php.Config filepath) spec+ +          Python {..} -> do+            Python.generate (Python.Config filepath) spec+ +          Ruby {..} -> do+            Ruby.generate (Ruby.Config filepath modules) spec

@@ -1,58 +1,67 @@-Name:                msgpack-idl-Version:             0.1.0-Synopsis:            An IDL Compiler for MessagePack-Description:         An IDL Compiler for MessagePack <http://msgpack.org/>-Homepage:            http://msgpack.org/-License:             BSD3-License-file:        LICENSE-Author:              Hideyuki Tanaka-Maintainer:          Hideyuki Tanaka <tanaka.hideyuki@gmail.com>-Copyright:           Copyright (c) 2011, Hideyuki Tanaka-Category:            Language-Stability:           Experimental-Cabal-version:       >=1.8-Build-type:          Simple+name:                msgpack-idl+version:             0.2.0+synopsis:            An IDL Compiler for MessagePack+description:         An IDL Compiler for MessagePack <http://msgpack.org/>+homepage:            http://msgpack.org/+license:             BSD3+license-file:        LICENSE+author:              Hideyuki Tanaka+maintainer:          Hideyuki Tanaka <tanaka.hideyuki@gmail.com>+copyright:           Copyright (c) 2011, Hideyuki Tanaka+category:            Language+stability:           Experimental+cabal-version:       >=1.8+build-type:          Simple -Extra-source-files:  mpidl.peggy+extra-source-files:  mpidl.peggy -Source-repository head-  Type:                git-  Location:            git://github.com/msgpack/msgpack-haskell.git+source-repository head+  type:                git+  location:            git://github.com/msgpack/msgpack-haskell.git -Library-  Build-depends:       base             == 4.*+library+  build-depends:       base             == 4.*                      , bytestring       == 0.9.*                      , text             == 0.11.*-                     , shakespeare-text == 0.10.*+                     , shakespeare-text == 1.0.*                      , blaze-builder    == 0.3.*                      , template-haskell >= 2.5 && < 2.8                      , containers       == 0.4.*-                     , filepath         >= 1.2 && < 1.4+                     , filepath         >= 1.1 && < 1.4+                     , directory                      , msgpack          == 0.7.*                      , peggy            == 0.3.* -  Ghc-options:         -Wall+  ghc-options:         -Wall   -  Exposed-modules:     Language.MessagePack.IDL+  exposed-modules:     Language.MessagePack.IDL                        Language.MessagePack.IDL.Check                        Language.MessagePack.IDL.CodeGen.Cpp                        Language.MessagePack.IDL.CodeGen.Haskell                        Language.MessagePack.IDL.CodeGen.Java                        Language.MessagePack.IDL.CodeGen.Perl                        Language.MessagePack.IDL.CodeGen.Php-                       Language.MessagePack.IDL.CodeGen.Py+                       Language.MessagePack.IDL.CodeGen.Python                        Language.MessagePack.IDL.CodeGen.Ruby+                       Language.MessagePack.IDL.Internal                        Language.MessagePack.IDL.Parser                        Language.MessagePack.IDL.Syntax-  -  Other-modules:        -Executable mpidl-  Hs-source-dirs:      exec-  Main-is:             Main.hs+executable mpidl+  hs-source-dirs:      exec+  main-is:             main.hs -  Build-depends:       base      == 4.*-                     , directory == 1.1.*+  build-depends:       base      == 4.*+                     , directory >= 1.0 && < 1.2                      , cmdargs   == 0.9.*                      , peggy     == 0.3.*+                     , msgpack-idl++test-suite mpidl-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             test.hs++  build-depends:       base      == 4.*+                     , hspec     >= 1.1                      , msgpack-idl

@@ -0,0 +1,18 @@+import Test.Hspec.Monadic++main :: IO ()+main = hspecX $ do+  describe "parser" $ do+    it "can parse xxx..." $ do+      pending++  describe "checker" $ do+    it "can check xxx..." $ do+      pending++  describe "generator" $ do+    describe "haskell" $ do+      it "can generate client" $ do+        pending+      it "can communicate reference server" $ do+        pending