compiler/cpp/src/generate/t_hs_generator.cc

   1 // Copyright (c) 2006- Facebook
   2 // Distributed under the Thrift Software License
   3 //
   4 // See accompanying file LICENSE or visit the Thrift site at:
   5 // http://developers.facebook.com/thrift/
   6
   7 #include <stdlib.h>
   8 #include <sys/stat.h>
   9 #include <sys/types.h>
  10 #include <sstream>
  11 #include "t_hs_generator.h"
  12 using namespace std;
  13
  14 /*
  15  * This is necessary because we want typedefs to appear later,
  16  * after all the types have been declared.
  17  */
  18 void t_hs_generator::generate_program() {
  19   // Initialize the generator
  20   init_generator();
  21
  22   // Generate enums
  23   vector<t_enum*> enums = program_->get_enums();
  24   vector<t_enum*>::iterator en_iter;
  25   for (en_iter = enums.begin(); en_iter != enums.end(); ++en_iter) {
  26     generate_enum(*en_iter);
  27   }
  28
  29   // Generate structs
  30   vector<t_struct*> structs = program_->get_structs();
  31   vector<t_struct*>::iterator st_iter;
  32   for (st_iter = structs.begin(); st_iter != structs.end(); ++st_iter) {
  33     generate_struct(*st_iter);
  34   }
  35
  36   // Generate xceptions
  37   vector<t_struct*> xceptions = program_->get_xceptions();
  38   vector<t_struct*>::iterator x_iter;
  39   for (x_iter = xceptions.begin(); x_iter != xceptions.end(); ++x_iter) {
  40     generate_xception(*x_iter);
  41   }
  42
  43   // Generate typedefs
  44   vector<t_typedef*> typedefs = program_->get_typedefs();
  45   vector<t_typedef*>::iterator td_iter;
  46   for (td_iter = typedefs.begin(); td_iter != typedefs.end(); ++td_iter) {
  47     generate_typedef(*td_iter);
  48   }
  49
  50   // Generate services
  51   vector<t_service*> services = program_->get_services();
  52   vector<t_service*>::iterator sv_iter;
  53   for (sv_iter = services.begin(); sv_iter != services.end(); ++sv_iter) {
  54     service_name_ = get_service_name(*sv_iter);
  55     generate_service(*sv_iter);
  56   }
  57
  58   // Generate constants
  59   vector<t_const*> consts = program_->get_consts();
  60   generate_consts(consts);
  61
  62   // Close the generator
  63   close_generator();
  64 }
  65
  66
  67 /**
  68  * Prepares for file generation by opening up the necessary file output
  69  * streams.
  70  *
  71  * @param tprogram The program to generate
  72  */
  73 void t_hs_generator::init_generator() {
  74   // Make output directory
  75   mkdir(get_out_dir().c_str(), S_IRWXU | S_IRWXG | S_IRWXO);
  76
  77   // Make output file
  78
  79   string pname = capitalize(program_name_);
  80   string f_types_name = get_out_dir()+pname+"_Types.hs";
  81   f_types_.open(f_types_name.c_str());
  82
  83   string f_consts_name = get_out_dir()+pname+"_Consts.hs";
  84   f_consts_.open(f_consts_name.c_str());
  85
  86   // Print header
  87   f_types_ <<
  88     hs_autogen_comment() << endl <<
  89     "module " << pname <<"_Types where" << endl <<
  90     hs_imports() << endl;
  91
  92   f_consts_ <<
  93     hs_autogen_comment() << endl <<
  94     "module " << pname <<"_Consts where" << endl <<
  95     hs_imports() << endl <<
  96     "import " << pname<<"_Types"<< endl;
  97
  98 }
  99
 100
 101 /**
 102  * Autogen'd comment
 103  */
 104 string t_hs_generator::hs_autogen_comment() {
 105   return
 106     std::string("-----------------------------------------------------------------\n") +
 107     "-- Autogenerated by Thrift                                     --\n" +
 108     "--                                                             --\n" +
 109     "-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --\n" +
 110     "-----------------------------------------------------------------\n";
 111 }
 112
 113 /**
 114  * Prints standard thrift imports
 115  */
 116 string t_hs_generator::hs_imports() {
 117   return "import Thrift\nimport Data.Generics\nimport Control.Exception\nimport qualified Data.Map as Map\nimport qualified Data.Set as Set\nimport Data.Int";
 118 }
 119
 120 /**
 121  * Closes the type files
 122  */
 123 void t_hs_generator::close_generator() {
 124   // Close types file
 125   f_types_.close();
 126   f_consts_.close();
 127 }
 128
 129 /**
 130  * Generates a typedef. Ez.
 131  *
 132  * @param ttypedef The type definition
 133  */
 134 void t_hs_generator::generate_typedef(t_typedef* ttypedef) {
 135   f_types_ <<
 136     indent() << "type "<< capitalize(ttypedef->get_symbolic()) << " = " << render_hs_type(ttypedef->get_type()) << endl << endl;
 137 }
 138
 139 /**
 140  * Generates code for an enumerated type.
 141  * the values.
 142  *
 143  * @param tenum The enumeration
 144  */
 145 void t_hs_generator::generate_enum(t_enum* tenum) {
 146   indent(f_types_) << "data "<<capitalize(tenum->get_name())<<" = ";
 147   indent_up();
 148   vector<t_enum_value*> constants = tenum->get_constants();
 149   vector<t_enum_value*>::iterator c_iter;
 150   bool first = true;
 151   for (c_iter = constants.begin(); c_iter != constants.end(); ++c_iter) {
 152     string name = capitalize((*c_iter)->get_name());
 153     if(first)
 154       first=false;
 155     else
 156       f_types_ << "|";
 157     f_types_ << name;
 158   }
 159   indent(f_types_) << "deriving (Show,Eq, Typeable, Data, Ord)" << endl;
 160   indent_down();
 161
 162   int value = -1;
 163   indent(f_types_) << "instance Enum " << capitalize(tenum->get_name()) << " where" << endl;
 164   indent_up();
 165   indent(f_types_) << "fromEnum t = case t of" << endl;
 166   indent_up();
 167   for (c_iter = constants.begin(); c_iter != constants.end(); ++c_iter) {
 168     if ((*c_iter)->has_value()) {
 169       value = (*c_iter)->get_value();
 170     } else {
 171       ++value;
 172     }
 173     string name = capitalize((*c_iter)->get_name());
 174
 175     f_types_ <<
 176       indent() << name << " -> " << value << endl;
 177   }
 178   indent_down();
 179
 180   indent(f_types_) << "toEnum t = case t of" << endl;
 181   indent_up();
 182   for(c_iter = constants.begin(); c_iter != constants.end(); ++c_iter) {
 183     if ((*c_iter)->has_value()) {
 184       value = (*c_iter)->get_value();
 185     } else {
 186       ++value;
 187     }
 188     string name = capitalize((*c_iter)->get_name());
 189
 190     f_types_ <<
 191       indent() << value << " -> " << name << endl;
 192   }
 193   indent(f_types_) << "_ -> throwDyn Thrift_Error" << endl;
 194   indent_down();
 195   indent_down();
 196 }
 197
 198 /**
 199  * Generate a constant value
 200  */
 201 void t_hs_generator::generate_const(t_const* tconst) {
 202   t_type* type = tconst->get_type();
 203   string name = decapitalize(tconst->get_name());
 204   t_const_value* value = tconst->get_value();
 205
 206   indent(f_consts_) << name << " = " << render_const_value(type, value) << endl << endl;
 207 }
 208
 209 /**
 210  * Prints the value of a constant with the given type. Note that type checking
 211  * is NOT performed in this function as it is always run beforehand using the
 212  * validate_types method in main.cc
 213  */
 214 string t_hs_generator::render_const_value(t_type* type, t_const_value* value) {
 215   std::ostringstream out;
 216   if (type->is_base_type()) {
 217     t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
 218     switch (tbase) {
 219     case t_base_type::TYPE_STRING:
 220       out << "\"" << value->get_string() << "\"";
 221       break;
 222     case t_base_type::TYPE_BOOL:
 223       out << (value->get_integer() > 0 ? "True" : "False");
 224       break;
 225     case t_base_type::TYPE_BYTE:
 226     case t_base_type::TYPE_I16:
 227     case t_base_type::TYPE_I32:
 228     case t_base_type::TYPE_I64:
 229       out << value->get_integer();
 230       break;
 231     case t_base_type::TYPE_DOUBLE:
 232       if (value->get_type() == t_const_value::CV_INTEGER) {
 233         out << value->get_integer();
 234       } else {
 235         out << value->get_double();
 236       }
 237       break;
 238     default:
 239       throw "compiler error: no const of base type " + t_base_type::t_base_name(tbase);
 240     }
 241   } else if (type->is_enum()) {
 242     t_enum* tenum = (t_enum*)type;
 243     vector<t_enum_value*> constants = tenum->get_constants();
 244     vector<t_enum_value*>::iterator c_iter;
 245     int val = -1;
 246     for (c_iter = constants.begin(); c_iter != constants.end(); ++c_iter) {
 247       if ((*c_iter)->has_value()) {
 248         val = (*c_iter)->get_value();
 249       } else {
 250         ++val;
 251       }
 252       if(val == value->get_integer()){
 253         indent(out) << capitalize((*c_iter)->get_name());
 254         break;
 255       }
 256     }
 257   } else if (type->is_struct() || type->is_xception()) {
 258     string cname = type_name(type);
 259     indent(out) << cname << "{";
 260     const vector<t_field*>& fields = ((t_struct*)type)->get_members();
 261     vector<t_field*>::const_iterator f_iter;
 262     const map<t_const_value*, t_const_value*>& val = value->get_map();
 263     map<t_const_value*, t_const_value*>::const_iterator v_iter;
 264     bool first = true;
 265     for (v_iter = val.begin(); v_iter != val.end(); ++v_iter) {
 266       t_type* field_type = NULL;
 267       for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
 268         if ((*f_iter)->get_name() == v_iter->first->get_string()) {
 269           field_type = (*f_iter)->get_type();
 270         }
 271       }
 272       if (field_type == NULL) {
 273         throw "type error: " + type->get_name() + " has no field " + v_iter->first->get_string();
 274       }
 275       string fname = v_iter->first->get_string();
 276       if(first)
 277         first=false;
 278       else
 279         out << ",";
 280       out << "f_" << cname << "_" << fname << " = Just (" << render_const_value(field_type, v_iter->second) << ")";
 281
 282     }
 283     indent(out) << "}";
 284   } else if (type->is_map()) {
 285     t_type* ktype = ((t_map*)type)->get_key_type();
 286     t_type* vtype = ((t_map*)type)->get_val_type();
 287     const map<t_const_value*, t_const_value*>& val = value->get_map();
 288     map<t_const_value*, t_const_value*>::const_iterator v_iter;
 289     out << "(Map.fromList [";
 290     bool first=true;
 291     for (v_iter = val.begin(); v_iter != val.end(); ++v_iter) {
 292       string key = render_const_value(ktype, v_iter->first);
 293       string val = render_const_value(vtype, v_iter->second);
 294       if(first)
 295         first=false;
 296       else
 297         out << ",";
 298       out << "(" << key << ","<< val << ")";
 299     }
 300     out << "])";
 301   } else if (type->is_list()) {
 302     t_type* etype;
 303     etype = ((t_list*)type)->get_elem_type();
 304     out << "[";
 305     const vector<t_const_value*>& val = value->get_list();
 306     vector<t_const_value*>::const_iterator v_iter;
 307     bool first=true;
 308     for (v_iter = val.begin(); v_iter != val.end(); ++v_iter) {
 309       if(first)
 310         first=false;
 311       else
 312         out << ",";
 313       out << render_const_value(etype, *v_iter);
 314     }
 315     out << "]";
 316   } else if (type->is_set()) {
 317     t_type* etype = ((t_set*)type)->get_elem_type();
 318     const vector<t_const_value*>& val = value->get_list();
 319     vector<t_const_value*>::const_iterator v_iter;
 320     out << "(mkSet [";
 321     for (v_iter = val.begin(); v_iter != val.end(); ++v_iter) {
 322       string val = render_const_value(etype, *v_iter);
 323       out << val;
 324     }
 325     out << "])";
 326   }
 327   return out.str();
 328 }
 329
 330 /**
 331  * Generates a "struct"
 332  */
 333 void t_hs_generator::generate_struct(t_struct* tstruct) {
 334   generate_hs_struct(tstruct, false);
 335 }
 336
 337 /**
 338  * Generates a struct definition for a thrift exception. Basically the same
 339  * as a struct, but also has an exception declaration.
 340  *
 341  * @param txception The struct definition
 342  */
 343 void t_hs_generator::generate_xception(t_struct* txception) {
 344   generate_hs_struct(txception, true);
 345 }
 346
 347 /**
 348  * Generates a Haskell struct
 349  */
 350 void t_hs_generator::generate_hs_struct(t_struct* tstruct,
 351                                               bool is_exception) {
 352   generate_hs_struct_definition(f_types_,tstruct, is_exception,false);
 353 }
 354
 355 /**
 356  * Generates a struct definition for a thrift data type.
 357  *
 358  * @param tstruct The struct definition
 359  */
 360 void t_hs_generator::generate_hs_struct_definition(ofstream& out,
 361                                                    t_struct* tstruct,
 362                                                    bool is_exception,
 363                                                    bool helper) {
 364   string tname = type_name(tstruct);
 365   string name = tstruct->get_name();
 366   const vector<t_field*>& members = tstruct->get_members();
 367   vector<t_field*>::const_iterator m_iter;
 368
 369   indent(out) << "data "<<tname<<" = "<<tname;
 370   if (members.size() > 0) {
 371     out << "{";
 372     bool first=true;
 373     for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) {
 374       if(first)
 375         first=false;
 376       else
 377         out << ",";
 378       string mname = (*m_iter)->get_name();
 379       out << "f_" << tname << "_" << mname << " :: Maybe (" << render_hs_type((*m_iter)->get_type()) << ")";
 380     }
 381     out << "}";
 382   }
 383
 384   out << " deriving (Show,Eq,Ord,Typeable)" << endl;
 385
 386   generate_hs_struct_writer(out, tstruct);
 387
 388   generate_hs_struct_reader(out, tstruct);
 389   //f_struct_.close();
 390 }
 391
 392
 393
 394 /**
 395  * Generates the read method for a struct
 396  */
 397 void t_hs_generator::generate_hs_struct_reader(ofstream& out, t_struct* tstruct) {
 398   const vector<t_field*>& fields = tstruct->get_members();
 399   vector<t_field*>::const_iterator f_iter;
 400   string sname = type_name(tstruct);
 401   string str = tmp("_str");
 402   string t = tmp("_t");
 403   string id = tmp("_id");
 404
 405   indent(out) << "read_" << sname << "_fields iprot rec = do" << endl;
 406   indent_up(); // do
 407
 408   // Read beginning field marker
 409   indent(out) << "(_," << t <<","<<id<<") <- readFieldBegin iprot" << endl;
 410   // Check for field STOP marker and break
 411   indent(out) <<
 412     "if " << t <<" == T_STOP then return rec else" << endl;
 413   indent_up(); // if
 414   indent(out) << "case " << id<<" of " << endl;
 415   indent_up(); // case
 416   // Generate deserialization code for known cases
 417   for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
 418     indent(out) << (*f_iter)->get_key() << " -> ";
 419     out << "if " << t <<" == " << type_to_enum((*f_iter)->get_type()) << " then do" << endl;
 420     indent_up(); // if
 421     indent(out) << "s <- ";
 422     generate_deserialize_field(out, *f_iter,str);
 423     out << endl;
 424     indent(out) << "read_"<<sname<<"_fields iprot rec{f_"<<sname<<"_"<< decapitalize((*f_iter)->get_name()) <<"=Just s}" << endl;
 425     out <<
 426       indent() << "else do" << endl;
 427     indent_up();
 428     indent(out) << "skip iprot "<< t << endl;
 429     indent(out) << "read_"<<sname<<"_fields iprot rec" << endl;
 430     indent_down(); // -do
 431     indent_down(); // -if
 432   }
 433
 434
 435   // In the default case we skip the field
 436   out <<
 437     indent() << "_ -> do" << endl;
 438   indent_up();
 439   indent(out) << "skip iprot "<<t<< endl;
 440   indent(out) << "readFieldEnd iprot" << endl;
 441   indent(out) << "read_"<<sname<<"_fields iprot rec" << endl;
 442   indent_down(); // -case
 443   indent_down(); // -if
 444   indent_down(); // -do
 445   indent_down();
 446
 447   // read
 448   indent(out) << "read_"<<sname<<" iprot = do" << endl;
 449   indent_up();
 450   indent(out) << "readStructBegin iprot" << endl;
 451   indent(out) << "rec <- read_"<<sname<<"_fields iprot ("<<sname<<"{";
 452   bool first = true;
 453   for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
 454     if(first)
 455       first=false;
 456     else
 457       out << ",";
 458     out << "f_" << sname << "_" << decapitalize((*f_iter)->get_name()) << "=Nothing";
 459   }
 460   out << "})" << endl;
 461   indent(out) << "readStructEnd iprot" << endl;
 462   indent(out) << "return rec" << endl;
 463   indent_down();
 464 }
 465
 466 void t_hs_generator::generate_hs_struct_writer(ofstream& out,
 467                                                t_struct* tstruct) {
 468   string name = type_name(tstruct);
 469   const vector<t_field*>& fields = tstruct->get_members();
 470   vector<t_field*>::const_iterator f_iter;
 471   string str = tmp("_str");
 472   string f = tmp("_f");
 473
 474   indent(out) <<
 475     "write_"<<name<<" oprot rec = do" << endl;
 476   indent_up();
 477   indent(out) <<
 478     "writeStructBegin oprot \""<<name<<"\"" << endl;
 479   for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
 480     // Write field header
 481     string mname = (*f_iter)->get_name();
 482     indent(out) <<
 483       "case f_" << name << "_" << mname << " rec of {Nothing -> return (); Just _v -> do" << endl;
 484     indent_up();
 485     indent(out) << "writeFieldBegin oprot (\""<< (*f_iter)->get_name()<<"\","
 486                 <<type_to_enum((*f_iter)->get_type())<<","
 487                 <<(*f_iter)->get_key()<<")" << endl;
 488
 489     // Write field contents
 490     out << indent();
 491     generate_serialize_field(out, *f_iter, "_v");
 492     out << endl;
 493     // Write field closer
 494     indent(out) << "writeFieldEnd oprot}" << endl;
 495     indent_down();
 496   }
 497
 498   // Write the struct map
 499   out <<
 500     indent() << "writeFieldStop oprot" << endl <<
 501     indent() << "writeStructEnd oprot" << endl;
 502
 503   indent_down();
 504 }
 505
 506 /**
 507  * Generates a thrift service.
 508  *
 509  * @param tservice The service definition
 510  */
 511 void t_hs_generator::generate_service(t_service* tservice) {
 512   string f_service_name = get_out_dir()+capitalize(service_name_)+".hs";
 513   f_service_.open(f_service_name.c_str());
 514
 515   f_service_ <<
 516     hs_autogen_comment() << endl <<
 517     "module " << capitalize(service_name_) << " where" << endl <<
 518     hs_imports() << endl;
 519
 520
 521   if(tservice->get_extends()){
 522     f_service_ <<
 523       "import qualified " << capitalize(tservice->get_extends()->get_name()) << endl;
 524   }
 525
 526
 527   f_service_ <<
 528      "import " << capitalize(program_name_) << "_Types" << endl <<
 529     "import qualified " << capitalize(service_name_) << "_Iface as Iface" << endl;
 530
 531
 532   // Generate the three main parts of the service
 533   generate_service_helpers(tservice);
 534   generate_service_interface(tservice);
 535   generate_service_client(tservice);
 536   generate_service_server(tservice);
 537
 538
 539   // Close service file
 540   f_service_.close();
 541 }
 542
 543 /**
 544  * Generates helper functions for a service.
 545  *
 546  * @param tservice The service to generate a header definition for
 547  */
 548 void t_hs_generator::generate_service_helpers(t_service* tservice) {
 549   vector<t_function*> functions = tservice->get_functions();
 550   vector<t_function*>::iterator f_iter;
 551
 552   indent(f_service_) <<
 553     "-- HELPER FUNCTIONS AND STRUCTURES --" << endl << endl;
 554
 555   for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
 556     t_struct* ts = (*f_iter)->get_arglist();
 557     generate_hs_struct_definition(f_service_,ts, false);
 558     generate_hs_function_helpers(*f_iter);
 559   }
 560 }
 561
 562 /**
 563  * Generates a struct and helpers for a function.
 564  *
 565  * @param tfunction The function
 566  */
 567 void t_hs_generator::generate_hs_function_helpers(t_function* tfunction) {
 568   t_struct result(program_, decapitalize(tfunction->get_name()) + "_result");
 569   t_field success(tfunction->get_returntype(), "success", 0);
 570   if (!tfunction->get_returntype()->is_void()) {
 571     result.append(&success);
 572   }
 573
 574   t_struct* xs = tfunction->get_xceptions();
 575   const vector<t_field*>& fields = xs->get_members();
 576   vector<t_field*>::const_iterator f_iter;
 577   for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
 578     result.append(*f_iter);
 579   }
 580   generate_hs_struct_definition(f_service_,&result, false);
 581 }
 582
 583 /**
 584  * Generates a service interface definition.
 585  *
 586  * @param tservice The service to generate a header definition for
 587  */
 588 void t_hs_generator::generate_service_interface(t_service* tservice) {
 589   string f_iface_name = get_out_dir()+capitalize(service_name_)+"_Iface.hs";
 590   f_iface_.open(f_iface_name.c_str());
 591   indent(f_iface_) << "module " << capitalize(service_name_) << "_Iface where" << endl;
 592
 593   indent(f_iface_) <<
 594     hs_imports() << endl <<
 595     "import " << capitalize(program_name_) << "_Types" << endl <<
 596     endl;
 597
 598   if (tservice->get_extends() != NULL) {
 599     string extends = type_name(tservice->get_extends());
 600     indent(f_iface_) << "import " << extends <<"_Iface" << endl;
 601     indent(f_iface_) << "class "<< extends << "_Iface a => " << capitalize(service_name_) << "_Iface a where" << endl;
 602   } else {
 603     f_iface_ << indent() << "class " << capitalize(service_name_) << "_Iface a where" << endl;
 604   }
 605   indent_up();
 606
 607   vector<t_function*> functions = tservice->get_functions();
 608   vector<t_function*>::iterator f_iter;
 609   for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
 610     string ft = function_type(*f_iter,true,true,true);
 611     f_iface_ <<
 612       indent() << decapitalize((*f_iter)->get_name()) << " :: a -> " << ft  << endl;
 613   }
 614   indent_down();
 615   f_iface_.close();
 616
 617 }
 618
 619 /**
 620  * Generates a service client definition. Note that in Haskell, the client doesn't implement iface. This is because
 621  * The client does not (and should not have to) deal with arguments being Nothing.
 622  *
 623  * @param tservice The service to generate a server for.
 624  */
 625 void t_hs_generator::generate_service_client(t_service* tservice) {
 626   string f_client_name = get_out_dir()+capitalize(service_name_)+"_Client.hs";
 627   f_client_.open(f_client_name.c_str());
 628
 629   vector<t_function*> functions = tservice->get_functions();
 630   vector<t_function*>::const_iterator f_iter;
 631
 632   string extends = "";
 633   string exports="";
 634   bool first = true;
 635   for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
 636     if(first)
 637       first=false;
 638     else
 639       exports+=",";
 640     string funname = (*f_iter)->get_name();
 641     exports+=funname;
 642   }
 643   indent(f_client_) << "module " << capitalize(service_name_) << "_Client("<<exports<<") where" << endl;
 644
 645   if (tservice->get_extends() != NULL) {
 646     extends = type_name(tservice->get_extends());
 647     indent(f_client_) << "import " << extends << "_Client" << endl;
 648   }
 649   indent(f_client_) << "import Data.IORef" << endl;
 650   indent(f_client_) << hs_imports() << endl;
 651   indent(f_client_) << "import " << capitalize(program_name_) << "_Types" << endl;
 652   indent(f_client_) << "import " << capitalize(service_name_) << endl;
 653   // DATS RITE A GLOBAL VAR
 654   indent(f_client_) << "seqid = newIORef 0" << endl;
 655
 656
 657   // Generate client method implementations
 658
 659   for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
 660     t_struct* arg_struct = (*f_iter)->get_arglist();
 661     const vector<t_field*>& fields = arg_struct->get_members();
 662     vector<t_field*>::const_iterator fld_iter;
 663     string funname = (*f_iter)->get_name();
 664
 665     string fargs = "";
 666     for (fld_iter = fields.begin(); fld_iter != fields.end(); ++fld_iter) {
 667       fargs+= " arg_" + decapitalize((*fld_iter)->get_name());
 668     }
 669
 670     // Open function
 671     indent(f_client_) << funname << " (ip,op)" <<  fargs << " = do" << endl;
 672     indent_up();
 673     indent(f_client_) <<  "send_" << funname << " op" << fargs;
 674
 675     f_client_ << endl;
 676
 677     if (!(*f_iter)->is_async()) {
 678       f_client_ << indent();
 679       f_client_ <<
 680         "recv_" << funname << " ip" << endl;
 681     }
 682     indent_down();
 683
 684     indent(f_client_) <<
 685       "send_" << funname << " op" << fargs << " = do" << endl;
 686     indent_up();
 687     indent(f_client_) << "seq <- seqid" << endl;
 688     indent(f_client_) << "seqn <- readIORef seq" << endl;
 689     std::string argsname = capitalize((*f_iter)->get_name() + "_args");
 690
 691     // Serialize the request header
 692     f_client_ <<
 693       indent() << "writeMessageBegin op (\"" << (*f_iter)->get_name() << "\", M_CALL, seqn)" << endl;
 694     f_client_ << indent() << "write_" << argsname << " op ("<<argsname<<"{";
 695     bool first = true;
 696     for (fld_iter = fields.begin(); fld_iter != fields.end(); ++fld_iter) {
 697       if(first)
 698         first=false;
 699       else
 700         f_client_ << ",";
 701       f_client_ << "f_" << argsname <<"_" << (*fld_iter)->get_name() << "=Just arg_" << (*fld_iter)->get_name();
 702     }
 703     f_client_ << "})" << endl;
 704
 705     // Write to the stream
 706     f_client_ <<
 707       indent() << "writeMessageEnd op" << endl <<
 708       indent() << "pflush op" << endl;
 709
 710     indent_down();
 711
 712     if (!(*f_iter)->is_async()) {
 713       std::string resultname = capitalize((*f_iter)->get_name() + "_result");
 714       t_struct noargs(program_);
 715
 716       std::string funname = string("recv_") + (*f_iter)->get_name();
 717
 718       t_function recv_function((*f_iter)->get_returntype(),
 719                                funname,
 720                                &noargs);
 721       // Open function
 722       f_client_ <<
 723         indent() << funname << " ip = do" << endl;
 724       indent_up(); // fun
 725
 726       // TODO(mcslee): Validate message reply here, seq ids etc.
 727
 728       f_client_ <<
 729         indent() << "(fname, mtype, rseqid) <- readMessageBegin ip" << endl;
 730       f_client_ <<
 731         indent() << "if mtype == M_EXCEPTION then do" << endl <<
 732         indent() << "  x <- readAppExn ip" << endl;
 733       f_client_ <<
 734         indent() << "  throwDyn x" << endl;
 735       f_client_ <<
 736         indent() << "  else return ()" << endl;
 737
 738       t_struct* xs = (*f_iter)->get_xceptions();
 739       const std::vector<t_field*>& xceptions = xs->get_members();
 740
 741       f_client_ <<
 742         indent() << "res <- read_" << resultname << " ip" << endl;
 743       f_client_ <<
 744         indent() << "readMessageEnd ip" << endl;
 745
 746       // Careful, only return _result if not a void function
 747       if (!(*f_iter)->get_returntype()->is_void()) {
 748         f_client_ <<
 749           indent() << "case f_" << resultname << "_success res of" << endl;
 750         indent_up(); // case
 751         indent(f_client_) << "Just v -> return v" << endl;
 752         indent(f_client_) << "Nothing -> do" << endl;
 753         indent_up(); // none
 754       }
 755
 756
 757       vector<t_field*>::const_iterator x_iter;
 758       for (x_iter = xceptions.begin(); x_iter != xceptions.end(); ++x_iter) {
 759         f_client_ <<
 760           indent() << "case f_"<< resultname << "_" << (*x_iter)->get_name() << " res of" << endl;
 761         indent_up(); //case
 762         indent(f_client_) << "Nothing -> return ()" << endl;
 763         indent(f_client_) << "Just _v -> throwDyn _v" << endl;
 764         indent_down(); //-case
 765       }
 766
 767       // Careful, only return _result if not a void function
 768       if ((*f_iter)->get_returntype()->is_void()) {
 769         indent(f_client_) <<
 770           "return ()" << endl;
 771       } else {
 772         f_client_ <<
 773           indent() << "throwDyn (AppExn AE_MISSING_RESULT \"" << (*f_iter)->get_name() << " failed: unknown result\")" << endl;
 774         indent_down(); //-none
 775         indent_down(); //-case
 776       }
 777
 778       // Close function
 779       indent_down(); //-fun
 780     }
 781   }
 782   f_client_.close();
 783
 784
 785 }
 786
 787 /**
 788  * Generates a service server definition.
 789  *
 790  * @param tservice The service to generate a server for.
 791  */
 792 void t_hs_generator::generate_service_server(t_service* tservice) {
 793   // Generate the dispatch methods
 794   vector<t_function*> functions = tservice->get_functions();
 795   vector<t_function*>::iterator f_iter;
 796
 797   // Generate the process subfunctions
 798   for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
 799     generate_process_function(tservice, *f_iter);
 800   }
 801
 802
 803   indent(f_service_) << "proc handler (iprot,oprot) (name,typ,seqid) = case name of" << endl;
 804   indent_up();
 805   for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
 806     string fname = (*f_iter)->get_name();
 807     indent(f_service_) << "\""<<fname<<"\" -> process_" << decapitalize(fname) << " (seqid,iprot,oprot,handler)" << endl;
 808   }
 809   indent(f_service_) << "_ -> ";
 810   if(tservice->get_extends() != NULL){
 811     f_service_ << type_name(tservice->get_extends()) << ".proc handler (iprot,oprot) (name,typ,seqid)" << endl;
 812   } else {
 813     f_service_ << "do" << endl;
 814     indent_up();
 815     indent(f_service_) << "skip iprot T_STRUCT" << endl;
 816     indent(f_service_) << "readMessageEnd iprot" << endl;
 817     indent(f_service_) << "writeMessageBegin oprot (name,M_EXCEPTION,seqid)" << endl;
 818     indent(f_service_) << "writeAppExn oprot (AppExn AE_UNKNOWN_METHOD (\"Unknown function \" ++ name))" << endl;
 819     indent(f_service_) << "writeMessageEnd oprot" << endl;
 820     indent(f_service_) << "pflush oprot" << endl;
 821     indent_down();
 822   }
 823   indent_down();
 824
 825   // Generate the server implementation
 826   indent(f_service_) <<
 827     "process handler (iprot, oprot) = do" << endl;
 828   indent_up();
 829
 830   f_service_ <<
 831     indent() << "(name, typ, seqid) <- readMessageBegin iprot" << endl;
 832   f_service_ << indent() << "proc handler (iprot,oprot) (name,typ,seqid)" << endl;
 833   indent(f_service_) << "return True" << endl;
 834   indent_down();
 835
 836 }
 837
 838 /**
 839  * Generates a process function definition.
 840  *
 841  * @param tfunction The function to write a dispatcher for
 842  */
 843 void t_hs_generator::generate_process_function(t_service* tservice,
 844                                                t_function* tfunction) {
 845   // Open function
 846   indent(f_service_) <<
 847     "process_" << tfunction->get_name() << " (seqid, iprot, oprot, handler) = do" << endl;
 848   indent_up();
 849
 850   string argsname = capitalize(tfunction->get_name()) + "_args";
 851   string resultname = capitalize(tfunction->get_name()) + "_result";
 852
 853   // Generate the function call
 854   t_struct* arg_struct = tfunction->get_arglist();
 855   const std::vector<t_field*>& fields = arg_struct->get_members();
 856   vector<t_field*>::const_iterator f_iter;
 857
 858
 859   f_service_ <<
 860     indent() << "args <- read_" << argsname << " iprot" << endl;
 861   f_service_ <<
 862     indent() << "readMessageEnd iprot" << endl;
 863
 864   t_struct* xs = tfunction->get_xceptions();
 865   const std::vector<t_field*>& xceptions = xs->get_members();
 866   vector<t_field*>::const_iterator x_iter;
 867   int n = xceptions.size();
 868   if (!tfunction->is_async()){
 869     if(!tfunction->get_returntype()->is_void()){
 870       n++;
 871     }
 872     indent(f_service_) << "rs <- return (" << resultname;
 873
 874     for(int i=0; i<n;i++){
 875       f_service_ << " Nothing";
 876     }
 877     f_service_ << ")" << endl;
 878   }
 879
 880   indent(f_service_) << "res <- ";
 881   // Try block for a function with exceptions
 882   if (xceptions.size() > 0) {
 883     for(unsigned int i=0;i<xceptions.size();i++){
 884       f_service_ << "(catchDyn" << endl;
 885       indent_up();
 886       f_service_ << indent();
 887     }
 888   }
 889
 890   f_service_ << "(do" << endl;
 891   indent_up();
 892   f_service_ << indent();
 893   if (!tfunction->is_async() && !tfunction->get_returntype()->is_void()){
 894     f_service_ << "res <- ";
 895   }
 896   f_service_ << "Iface." << tfunction->get_name() << " handler";
 897   for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
 898     f_service_ <<  " (f_" << argsname <<  "_" << (*f_iter)->get_name() << " args)";
 899   }
 900
 901
 902   if (!tfunction->is_async() && !tfunction->get_returntype()->is_void()){
 903     f_service_ << endl;
 904     indent(f_service_) << "return rs{f_"<<resultname<<"_success= Just res}";
 905   } else if (!tfunction->is_async()){
 906     f_service_ << endl;
 907     indent(f_service_) << "return rs";
 908   }
 909   f_service_ << ")" << endl;
 910   indent_down();
 911
 912   if (xceptions.size() > 0 && !tfunction->is_async()) {
 913     for (x_iter = xceptions.begin(); x_iter != xceptions.end(); ++x_iter) {
 914       indent(f_service_) << "(\\e  -> " <<endl;
 915       indent_up();
 916       if(!tfunction->is_async()){
 917         f_service_ <<
 918           indent() << "return rs{f_"<<resultname<<"_" << (*x_iter)->get_name() << " =Just e}";
 919       } else {
 920         indent(f_service_) << "return ()";
 921       }
 922       f_service_ << "))" << endl;
 923       indent_down();
 924       indent_down();
 925     }
 926   }
 927
 928
 929
 930   // Shortcut out here for async functions
 931   if (tfunction->is_async()) {
 932     f_service_ <<
 933       indent() << "return ()" << endl;
 934     indent_down();
 935     return;
 936   }
 937
 938   f_service_ <<
 939     indent() << "writeMessageBegin oprot (\"" << tfunction->get_name() << "\", M_REPLY, seqid);" << endl <<
 940     indent() << "write_"<<resultname<<" oprot res" << endl <<
 941     indent() << "writeMessageEnd oprot" << endl <<
 942     indent() << "pflush oprot" << endl;
 943
 944   // Close function
 945   indent_down();
 946 }
 947
 948 /**
 949  * Deserializes a field of any type.
 950  */
 951 void t_hs_generator::generate_deserialize_field(ofstream &out,
 952                                                    t_field* tfield,
 953                                                    string prefix){
 954   t_type* type = tfield->get_type();
 955   generate_deserialize_type(out,type);
 956 }
 957
 958
 959 /**
 960  * Deserializes a field of any type.
 961  */
 962 void t_hs_generator::generate_deserialize_type(ofstream &out,
 963                                                    t_type* type){
 964   type = get_true_type(type);
 965
 966   if (type->is_void()) {
 967     throw "CANNOT GENERATE DESERIALIZE CODE FOR void TYPE";
 968   }
 969
 970
 971   if (type->is_struct() || type->is_xception()) {
 972     generate_deserialize_struct(out,
 973                                 (t_struct*)type);
 974   } else if (type->is_container()) {
 975     generate_deserialize_container(out, type);
 976   } else if (type->is_base_type()) {
 977     t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
 978     switch (tbase) {
 979     case t_base_type::TYPE_VOID:
 980       throw "compiler error: cannot serialize void field in a struct";
 981       break;
 982     case t_base_type::TYPE_STRING:
 983       out << "readString";
 984       break;
 985     case t_base_type::TYPE_BOOL:
 986       out << "readBool";
 987       break;
 988     case t_base_type::TYPE_BYTE:
 989       out << "readByte";
 990       break;
 991     case t_base_type::TYPE_I16:
 992       out << "readI16";
 993       break;
 994     case t_base_type::TYPE_I32:
 995       out << "readI32";
 996       break;
 997     case t_base_type::TYPE_I64:
 998       out << "readI64";
 999       break;
1000     case t_base_type::TYPE_DOUBLE:
1001       out << "readDouble";
1002       break;
1003     default:
1004       throw "compiler error: no PHP name for base type " + t_base_type::t_base_name(tbase);
1005     }
1006     out << " iprot";
1007   } else if (type->is_enum()) {
1008     string ename = capitalize(type->get_name());
1009     out << "(do {i <- readI32 iprot; return (toEnum i :: " << ename << ")})";
1010   } else {
1011     printf("DO NOT KNOW HOW TO DESERIALIZE TYPE '%s'\n",
1012            type->get_name().c_str());
1013   }
1014 }
1015
1016
1017 /**
1018  * Generates an unserializer for a struct, calling read()
1019  */
1020 void t_hs_generator::generate_deserialize_struct(ofstream &out,
1021                                                   t_struct* tstruct) {
1022   string name = capitalize(tstruct->get_name());
1023   out << "(read_" << name << " iprot)";
1024
1025 }
1026
1027 /**
1028  * Serialize a container by writing out the header followed by
1029  * data and then a footer.
1030  */
1031 void t_hs_generator::generate_deserialize_container(ofstream &out,
1032                                                     t_type* ttype) {
1033   string size = tmp("_size");
1034   string ktype = tmp("_ktype");
1035   string vtype = tmp("_vtype");
1036   string etype = tmp("_etype");
1037   string con = tmp("_con");
1038
1039   t_field fsize(g_type_i32, size);
1040   t_field fktype(g_type_byte, ktype);
1041   t_field fvtype(g_type_byte, vtype);
1042   t_field fetype(g_type_byte, etype);
1043
1044   // Declare variables, read header
1045   if (ttype->is_map()) {
1046     out << "(let {f 0 = return []; f n = do {k <- ";
1047     generate_deserialize_type(out,((t_map*)ttype)->get_key_type());
1048     out << "; v <- ";
1049     generate_deserialize_type(out,((t_map*)ttype)->get_val_type());
1050     out << ";r <- f (n-1); return $ (k,v):r}} in do {("<<ktype<<","<<vtype<<","<<size<<") <- readMapBegin iprot; l <- f " << size << "; return $ Map.fromList l})";
1051   } else if (ttype->is_set()) {
1052     out << "(let {f 0 = return []; f n = do {v <- ";
1053     generate_deserialize_type(out,((t_map*)ttype)->get_key_type());
1054     out << ";r <- f (n-1); return $ v:r}} in do {("<<etype<<","<<size<<") <- readSetBegin iprot; l <- f " << size << "; return $ Set.fromList l})";
1055   } else if (ttype->is_list()) {
1056     out << "(let {f 0 = return []; f n = do {v <- ";
1057     generate_deserialize_type(out,((t_map*)ttype)->get_key_type());
1058     out << ";r <- f (n-1); return $ v:r}} in do {("<<etype<<","<<size<<") <- readListBegin iprot; f " << size << "})";
1059   }
1060 }
1061
1062
1063 /**
1064  * Serializes a field of any type.
1065  *
1066  * @param tfield The field to serialize
1067  * @param prefix Name to prepend to field name
1068  */
1069 void t_hs_generator::generate_serialize_field(ofstream &out,
1070                                                  t_field* tfield,
1071                                                  string name) {
1072   t_type* type = get_true_type(tfield->get_type());
1073
1074   // Do nothing for void types
1075   if (type->is_void()) {
1076     throw "CANNOT GENERATE SERIALIZE CODE FOR void TYPE: " +
1077       tfield->get_name();
1078   }
1079
1080   if(name.length() == 0){
1081     name = decapitalize(tfield->get_name());
1082   }
1083
1084   if (type->is_struct() || type->is_xception()) {
1085     generate_serialize_struct(out,
1086                               (t_struct*)type,
1087                               name);
1088   } else if (type->is_container()) {
1089     generate_serialize_container(out,
1090                                  type,
1091                                  name);
1092   } else if (type->is_base_type() || type->is_enum()) {
1093     if (type->is_base_type()) {
1094       t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
1095       switch (tbase) {
1096       case t_base_type::TYPE_VOID:
1097         throw
1098           "compiler error: cannot serialize void field in a struct: " + name;
1099         break;
1100       case t_base_type::TYPE_STRING:
1101         out << "writeString oprot " << name;
1102         break;
1103       case t_base_type::TYPE_BOOL:
1104         out << "writeBool oprot " << name;
1105        break;
1106       case t_base_type::TYPE_BYTE:
1107         out << "writeByte oprot " << name;
1108         break;
1109       case t_base_type::TYPE_I16:
1110         out << "writeI16 oprot " << name;
1111         break;
1112       case t_base_type::TYPE_I32:
1113         out << "writeI32 oprot " << name;
1114         break;
1115       case t_base_type::TYPE_I64:
1116         out << "writeI64 oprot " << name;
1117         break;
1118       case t_base_type::TYPE_DOUBLE:
1119         out << "writeDouble oprot " << name;
1120         break;
1121       default:
1122         throw "compiler error: no hs name for base type " + t_base_type::t_base_name(tbase);
1123       }
1124
1125     } else if (type->is_enum()) {
1126       string ename = capitalize(type->get_name());
1127       out << "writeI32 oprot (fromEnum "<< name << ")";
1128     }
1129
1130   } else {
1131     printf("DO NOT KNOW HOW TO SERIALIZE FIELD '%s' TYPE '%s'\n",
1132            tfield->get_name().c_str(),
1133            type->get_name().c_str());
1134   }
1135 }
1136
1137 /**
1138  * Serializes all the members of a struct.
1139  *
1140  * @param tstruct The struct to serialize
1141  * @param prefix  String prefix to attach to all fields
1142  */
1143 void t_hs_generator::generate_serialize_struct(ofstream &out,
1144                                                t_struct* tstruct,
1145                                                string prefix) {
1146   out << "write_" << type_name(tstruct) << " oprot " << prefix;
1147 }
1148
1149 void t_hs_generator::generate_serialize_container(ofstream &out,
1150                                                   t_type* ttype,
1151                                                   string prefix) {
1152   if (ttype->is_map()) {
1153     string k = tmp("_kiter");
1154     string v = tmp("_viter");
1155     out << "(let {f [] = return (); f (("<<k<<","<<v<<"):t) = do {";
1156     generate_serialize_map_element(out, (t_map*)ttype, k, v);
1157     out << ";f t}} in do {writeMapBegin oprot ("<< type_to_enum(((t_map*)ttype)->get_key_type())<<","<< type_to_enum(((t_map*)ttype)->get_val_type())<<",Map.size " << prefix << "); f (Map.toList " << prefix << ");writeMapEnd oprot})";
1158   } else if (ttype->is_set()) {
1159     string v = tmp("_viter");
1160     out << "(let {f [] = return (); f ("<<v<<":t) = do {";
1161     generate_serialize_set_element(out, (t_set*)ttype, v);
1162     out << ";f t}} in do {writeSetBegin oprot ("<< type_to_enum(((t_set*)ttype)->get_elem_type())<<",Set.size " << prefix << "); f (Set.toList " << prefix << ");writeSetEnd oprot})";
1163   } else if (ttype->is_list()) {
1164     string v = tmp("_viter");
1165     out << "(let {f [] = return (); f ("<<v<<":t) = do {";
1166     generate_serialize_list_element(out, (t_list*)ttype, v);
1167     out << ";f t}} in do {writeListBegin oprot ("<< type_to_enum(((t_list*)ttype)->get_elem_type())<<",length " << prefix << "); f " << prefix << ";writeListEnd oprot})";
1168   }
1169
1170 }
1171
1172 /**
1173  * Serializes the members of a map.
1174  *
1175  */
1176 void t_hs_generator::generate_serialize_map_element(ofstream &out,
1177                                                      t_map* tmap,
1178                                                      string kiter,
1179                                                      string viter) {
1180   t_field kfield(tmap->get_key_type(), kiter);
1181   out << "do {";
1182   generate_serialize_field(out, &kfield);
1183   out << ";";
1184   t_field vfield(tmap->get_val_type(), viter);
1185   generate_serialize_field(out, &vfield);
1186   out << "}";
1187 }
1188
1189 /**
1190  * Serializes the members of a set.
1191  */
1192 void t_hs_generator::generate_serialize_set_element(ofstream &out,
1193                                                      t_set* tset,
1194                                                      string iter) {
1195   t_field efield(tset->get_elem_type(), iter);
1196   generate_serialize_field(out, &efield);
1197 }
1198
1199 /**
1200  * Serializes the members of a list.
1201  */
1202 void t_hs_generator::generate_serialize_list_element(ofstream &out,
1203                                                       t_list* tlist,
1204                                                       string iter) {
1205   t_field efield(tlist->get_elem_type(), iter);
1206   generate_serialize_field(out, &efield);
1207 }
1208
1209
1210 string t_hs_generator::function_type(t_function* tfunc, bool options, bool io, bool method){
1211   string result="";
1212
1213   const vector<t_field*>& fields = tfunc->get_arglist()->get_members();
1214   vector<t_field*>::const_iterator f_iter;
1215   for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
1216     if(options)
1217       result += "Maybe (";
1218     result += render_hs_type((*f_iter)->get_type());
1219     if(options)
1220       result+=")";
1221     result += " -> ";
1222   }
1223   if(fields.empty() && !method){
1224     result += "() -> ";
1225   }
1226   if(io) result += "IO (";
1227   result += render_hs_type(tfunc->get_returntype());
1228   if(io) result += ")";
1229   return result;
1230 }
1231
1232
1233 string t_hs_generator::type_name(t_type* ttype) {
1234   string prefix = "";
1235   t_program* program = ttype->get_program();
1236   if (program != NULL && program != program_) {
1237     if (!ttype->is_service()) {
1238       prefix = capitalize(program->get_name()) + "_Types.";
1239     }
1240   }
1241
1242   string name = ttype->get_name();
1243   if(ttype->is_service()){
1244     name = capitalize(name);
1245   } else {
1246     name = capitalize(name);
1247   }
1248   return prefix + name;
1249 }
1250
1251 /**
1252  * Converts the parse type to a Protocol.t_type enum
1253  */
1254 string t_hs_generator::type_to_enum(t_type* type) {
1255   type = get_true_type(type);
1256
1257   if (type->is_base_type()) {
1258     t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
1259     switch (tbase) {
1260     case t_base_type::TYPE_VOID:
1261       return "T_VOID";
1262     case t_base_type::TYPE_STRING:
1263       return "T_STRING";
1264     case t_base_type::TYPE_BOOL:
1265       return "T_BOOL";
1266     case t_base_type::TYPE_BYTE:
1267       return "T_BYTE";
1268     case t_base_type::TYPE_I16:
1269       return "T_I16";
1270     case t_base_type::TYPE_I32:
1271       return "T_I32";
1272     case t_base_type::TYPE_I64:
1273       return "T_I64";
1274     case t_base_type::TYPE_DOUBLE:
1275       return "T_DOUBLE";
1276     }
1277   } else if (type->is_enum()) {
1278     return "T_I32";
1279   } else if (type->is_struct() || type->is_xception()) {
1280     return "T_STRUCT";
1281   } else if (type->is_map()) {
1282     return "T_MAP";
1283   } else if (type->is_set()) {
1284     return "T_SET";
1285   } else if (type->is_list()) {
1286     return "T_LIST";
1287   }
1288
1289   throw "INVALID TYPE IN type_to_enum: " + type->get_name();
1290 }
1291
1292 /**
1293  * Converts the parse type to an haskell type
1294  */
1295 string t_hs_generator::render_hs_type(t_type* type) {
1296   type = get_true_type(type);
1297
1298   if (type->is_base_type()) {
1299     t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
1300     switch (tbase) {
1301     case t_base_type::TYPE_VOID:
1302       return "()";
1303     case t_base_type::TYPE_STRING:
1304       return "[Char]";
1305     case t_base_type::TYPE_BOOL:
1306       return "Bool";
1307     case t_base_type::TYPE_BYTE:
1308       return "Int";
1309     case t_base_type::TYPE_I16:
1310       return "Int";
1311     case t_base_type::TYPE_I32:
1312       return "Int";
1313     case t_base_type::TYPE_I64:
1314       return "Int";
1315     case t_base_type::TYPE_DOUBLE:
1316       return "Double";
1317     }
1318   } else if (type->is_enum()) {
1319     return capitalize(((t_enum*)type)->get_name());
1320   } else if (type->is_struct() || type->is_xception()) {
1321     return type_name((t_struct*)type);
1322   } else if (type->is_map()) {
1323     t_type* ktype = ((t_map*)type)->get_key_type();
1324     t_type* vtype = ((t_map*)type)->get_val_type();
1325     return "Map.Map ("+ render_hs_type(ktype)+") ("+render_hs_type(vtype)+")";
1326   } else if (type->is_set()) {
1327     t_type* etype = ((t_set*)type)->get_elem_type();
1328     return "Set.Set ("+render_hs_type(etype)+")";
1329   } else if (type->is_list()) {
1330     t_type* etype = ((t_list*)type)->get_elem_type();
1331     return "["+render_hs_type(etype)+"]";
1332   }
1333
1334   throw "INVALID TYPE IN type_to_enum: " + type->get_name();
1335 }