content: {-# 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}|]
  