diff --git a/.gitignore b/.gitignore
index b0b5e65..0b25fbd 100644
--- a/.gitignore
+++ b/.gitignore
@@ -18,6 +18,7 @@
 *_ReSharper*
 *.opensdf
 *.swp
+*.hi
 *~
 
 .*project
@@ -215,6 +216,8 @@
 /test/go/src/code.google.com/
 /test/go/src/gen/
 /test/go/src/thrift
+/test/hs/TestClient
+/test/hs/TestServer
 /test/py.twisted/_trial_temp/
 /test/rb/Gemfile.lock
 /tutorial/cpp/TutorialClient
diff --git a/compiler/cpp/src/generate/t_hs_generator.cc b/compiler/cpp/src/generate/t_hs_generator.cc
index 34479b6..fff7e53 100644
--- a/compiler/cpp/src/generate/t_hs_generator.cc
+++ b/compiler/cpp/src/generate/t_hs_generator.cc
@@ -28,6 +28,7 @@
 #include <sstream>
 
 #include "t_oop_generator.h"
+
 #include "platform.h"
 #include "version.h"
 
@@ -93,8 +94,18 @@
   void generate_hs_struct_writer     (ofstream& out,
                                       t_struct* tstruct);
 
+  void generate_hs_struct_arbitrary  (ofstream& out,
+                                      t_struct* tstruct);
+
   void generate_hs_function_helpers  (t_function* tfunction);
 
+  void generate_hs_typemap           (ofstream& out,
+                                      t_struct* tstruct);
+
+  void generate_hs_default           (ofstream& out,
+                                      t_struct* tstruct);
+
+
   /**
    * Service-level generation functions
    */
@@ -115,10 +126,12 @@
                                           string prefix);
 
   void generate_deserialize_struct       (ofstream &out,
-                                          t_struct* tstruct);
+                                          t_struct* tstruct,
+                                          string name = "");
 
   void generate_deserialize_container    (ofstream &out,
-                                          t_type* ttype);
+                                          t_type* ttype,
+                                          string arg = "");
 
   void generate_deserialize_set_element  (ofstream &out,
                                           t_set* tset);
@@ -129,10 +142,11 @@
                                           string prefix = "");
 
   void generate_deserialize_type          (ofstream &out,
-                                           t_type* type);
+                                           t_type* type,
+                                           string arg = "");
 
-  void generate_serialize_field          (ofstream &out,
-                                          t_field* tfield,
+  void generate_serialize_type           (ofstream &out,
+                                          t_type* type,
                                           string name = "");
 
   void generate_serialize_struct         (ofstream &out,
@@ -167,6 +181,8 @@
   string type_name(t_type* ttype,
                    string function_prefix = "");
 
+  string field_name(string tname, string fname);
+
   string function_type(t_function* tfunc,
                        bool options = false,
                        bool io = false,
@@ -174,10 +190,17 @@
 
   string type_to_enum(t_type* ttype);
 
+  string type_to_default(t_type* ttype);
+
   string render_hs_type(t_type* type,
                         bool needs_parens);
 
+  string type_to_constructor(t_type* ttype);
+
+  string render_hs_type_for_function_name(t_type *type);
+
  private:
+
   ofstream f_types_;
   ofstream f_consts_;
   ofstream f_service_;
@@ -243,20 +266,27 @@
 string t_hs_generator::hs_imports() {
   const vector<t_program*>& includes = program_->get_includes();
   string result = string(
-      "import qualified Prelude as P"
-      "\n"
-      "import qualified Control.Exception as Exc\n"
-      "import qualified Data.ByteString.Lazy as BL\n"
+      "import Prelude (($), (.), (>>=), (==), (++))\n"
+      "import qualified Prelude as P\n"
+      "import qualified Control.Exception as X\n"
+      "import qualified Control.Monad as M ( liftM, ap, when )\n"
+      "import Data.Functor ( (<$>) )\n"
+      "import qualified Data.ByteString.Lazy as LBS\n" 
       "import qualified Data.Hashable as H\n"
       "import qualified Data.Int as I\n"
-      "import qualified Data.Text.Lazy as TL\n"
-      "import qualified Data.Typeable as Typeable\n"
+      "import qualified Data.Maybe as M (catMaybes)\n"
+      "import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )\n"
+      "import qualified Data.Text.Lazy as LT\n"
+      "import qualified Data.Typeable as TY ( Typeable )\n"
       "import qualified Data.HashMap.Strict as Map\n"
       "import qualified Data.HashSet as Set\n"
       "import qualified Data.Vector as Vector\n"
+      "import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )\n"
+      "import qualified Test.QuickCheck as QC ( elements )\n"
       "\n"
       "import qualified Thrift as T\n"
-      "import Thrift.Types ()\n"
+      "import qualified Thrift.Types as T\n"
+      "import qualified Thrift.Arbitraries as T\n"
       "\n");
 
   for (size_t i = 0; i < includes.size(); ++i)
@@ -308,7 +338,7 @@
     f_types_ << name;
     first = false;
   }
-  indent(f_types_) << "deriving (P.Show, P.Eq, Typeable.Typeable, P.Ord)" << endl;
+  indent(f_types_) << "deriving (P.Show,P.Eq, TY.Typeable, P.Ord, P.Bounded)" << endl;
   indent_down();
 
   string ename = capitalize(tenum->get_name());
@@ -330,7 +360,7 @@
     string name = capitalize((*c_iter)->get_name());
     indent(f_types_) << value << " -> " << name << endl;
   }
-  indent(f_types_) << "_ -> Exc.throw T.ThriftException" << endl;
+  indent(f_types_) << "_ -> X.throw T.ThriftException" << endl;
   indent_down();
   indent_down();
 
@@ -338,6 +368,11 @@
   indent_up();
   indent(f_types_) << "hashWithSalt salt = H.hashWithSalt salt P.. P.fromEnum" << endl;
   indent_down();
+
+  indent(f_types_) << "instance QC.Arbitrary " << ename << " where" << endl;
+  indent_up();
+  indent(f_types_) << "arbitrary = QC.elements (P.enumFromTo P.minBound P.maxBound)" << endl;
+  indent_down();
 }
 
 /**
@@ -360,6 +395,9 @@
  * validate_types method in main.cc
  */
 string t_hs_generator::render_const_value(t_type* type, t_const_value* value) {
+  if (value == nullptr)
+    return type_to_default(type);
+
   type = get_true_type(type);
   ostringstream out;
 
@@ -376,19 +414,10 @@
       break;
 
     case t_base_type::TYPE_BYTE:
-      out << "(" << value->get_integer() << " :: I.Int8)";
-      break;
-
     case t_base_type::TYPE_I16:
-      out << "(" << value->get_integer() << " :: I.Int16)";
-      break;
-
     case t_base_type::TYPE_I32:
-      out << "(" << value->get_integer() << " :: I.Int32)";
-      break;
-
     case t_base_type::TYPE_I64:
-      out << "(" << value->get_integer() << " :: I.Int64)";
+      out << value->get_integer();
       break;
 
     case t_base_type::TYPE_DOUBLE:
@@ -407,17 +436,20 @@
     t_enum* tenum = (t_enum*)type;
     vector<t_enum_value*> constants = tenum->get_constants();
     vector<t_enum_value*>::iterator c_iter;
-    for (c_iter = constants.begin(); c_iter != constants.end(); ++c_iter) {
-      int val = (*c_iter)->get_value();
+    for (auto& c_iter : constants) {
+      int val = c_iter->get_value();
       if (val == value->get_integer()) {
-        indent(out) << capitalize((*c_iter)->get_name());
+        t_program* prog = type->get_program();
+        if (prog != nullptr && prog != program_)
+          out << capitalize(prog->get_name()) << "_Types.";
+        out << capitalize(c_iter->get_name());
         break;
       }
     }
 
   } else if (type->is_struct() || type->is_xception()) {
     string cname = type_name(type);
-    indent(out) << cname << "{";
+    out << "default_" << cname << "{";
 
     const vector<t_field*>& fields = ((t_struct*)type)->get_members();
     vector<t_field*>::const_iterator f_iter;
@@ -426,25 +458,30 @@
     map<t_const_value*, t_const_value*>::const_iterator v_iter;
 
     bool first = true;
-    for (v_iter = val.begin(); v_iter != val.end(); ++v_iter) {
-      t_type* field_type = NULL;
+    for (auto& v_iter : val) {
+      t_field* field = nullptr;
 
-      for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter)
-        if ((*f_iter)->get_name() == v_iter->first->get_string())
-          field_type = (*f_iter)->get_type();
+      for (auto& f_iter : fields)
+        if (f_iter->get_name() == v_iter.first->get_string())
+          field = f_iter;
 
-      if (field_type == NULL)
-        throw "type error: " + type->get_name() + " has no field " + v_iter->first->get_string();
+      if (field == nullptr)
+        throw "type error: " + cname + " has no field " + v_iter.first->get_string();
 
-      string fname = v_iter->first->get_string();
-      string const_value = render_const_value(field_type, v_iter->second);
+      string fname = v_iter.first->get_string();
+      string const_value = render_const_value(field->get_type(), v_iter.second);
 
-      out << (first ? "" : ",");
-      out << "f_" << cname << "_" << fname << " = P.Just (" << const_value << ")";
+      out << (first ? "" : ", ");
+      out << field_name(cname, fname) << " = ";
+      if (field->get_req() == t_field::T_OPTIONAL ||
+	  ((t_type*)field->get_type())->is_xception()) {
+        out << "P.Just ";
+      }
+      out << const_value;
       first = false;
     }
 
-    indent(out) << "}";
+    out << "}";
 
   } else if (type->is_map()) {
     t_type* ktype = ((t_map*)type)->get_key_type();
@@ -476,7 +513,7 @@
     if (type->is_set())
       out << "(Set.fromList [";
     else
-      out << "(Vector.fromList ";
+      out << "(Vector.fromList [";
 
     bool first = true;
     for (v_iter = val.begin(); v_iter != val.end(); ++v_iter) {
@@ -537,35 +574,103 @@
 
   indent(out) << "data " << tname << " = " << tname;
   if (members.size() > 0) {
-    out << "{";
-
+    indent_up();
     bool first = true;
-    for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) {
-      string mname = (*m_iter)->get_name();
-      out << (first ? "" : ",");
-      out << "f_" << tname << "_" << mname << " :: P.Maybe " << render_hs_type((*m_iter)->get_type(), true);
-      first = false;
+    for (auto* m_iter : members) {
+      if (first) {
+        indent(out) << "{ ";
+        first = false;
+      } else {
+        indent(out) << ", ";
+      }
+      string mname = m_iter->get_name();
+      out << field_name(tname, mname) << " :: ";
+      if (m_iter->get_req() == t_field::T_OPTIONAL ||
+	  ((t_type*)m_iter->get_type())->is_xception()) {
+        out << "P.Maybe ";
+      }
+      out << render_hs_type(m_iter->get_type(), true) << endl;
     }
-    out << "}";
+    indent(out) << "}";
+    indent_down();
   }
 
-  out << " deriving (P.Show, P.Eq, Typeable.Typeable)" << endl;
+  out << " deriving (P.Show,P.Eq,TY.Typeable)" << endl;
 
   if (is_exception)
-    out << "instance Exc.Exception " << tname << endl;
+    out << "instance X.Exception " << tname << endl;
 
   indent(out) << "instance H.Hashable " << tname << " where" << endl;
   indent_up();
   indent(out) << "hashWithSalt salt record = salt";
   for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) {
     string mname = (*m_iter)->get_name();
-    indent(out) << " `H.hashWithSalt` " << "f_" << tname << "_" << mname << " record";
+    indent(out) << " `H.hashWithSalt` " << field_name(tname, mname) << " record";
   }
   indent(out) << endl;
   indent_down();
 
+  generate_hs_struct_arbitrary(out, tstruct);
   generate_hs_struct_writer(out, tstruct);
   generate_hs_struct_reader(out, tstruct);
+  generate_hs_typemap(out, tstruct);
+  generate_hs_default(out, tstruct);
+}
+
+void t_hs_generator::generate_hs_struct_arbitrary(ofstream& out, t_struct* tstruct) {
+  string tname = type_name(tstruct);
+  string name = tstruct->get_name();
+  const vector<t_field*>& members = tstruct->get_members();
+  vector<t_field*>::const_iterator m_iter;
+
+  indent(out) << "instance QC.Arbitrary " << tname << " where "<< endl;
+  indent_up();
+  if (members.size() > 0) {
+    indent(out) << "arbitrary = M.liftM " << tname;
+    indent_up(); indent_up(); indent_up(); indent_up();
+    bool first=true;
+    for (auto* m_iter : members) {
+      if(first) {
+        first=false;
+        out << " ";
+      }
+      else {
+        indent(out) << "`M.ap`";
+      }
+      out << "(";
+      if (m_iter->get_req() == t_field::T_OPTIONAL ||
+	  ((t_type*)m_iter->get_type())->is_xception()) {
+        out << "M.liftM P.Just ";
+      }
+      out << "QC.arbitrary)" << endl;
+    }
+    indent_down(); indent_down(); indent_down(); indent_down();
+
+    // Shrink
+    indent(out) << "shrink obj | obj == default_" << tname << " = []" << endl;
+    indent(out) << "           | P.otherwise = M.catMaybes" << endl;
+    indent_up();
+    first = true;
+    for (auto& m_iter : members) {
+      if (first) {
+        first = false;
+        indent(out) << "[ ";
+      } else {
+        indent(out) << ", ";
+      }
+      string fname = field_name(tname, m_iter->get_name());
+      out << "if obj == default_" << tname;
+      out << "{" << fname << " = " << fname << " obj} ";
+      out << "then P.Nothing ";
+      out << "else P.Just $ default_" << tname;
+      out << "{" << fname << " = " << fname << " obj}" << endl;
+    }
+    indent(out) << "]" << endl;
+    indent_down();
+  } else { /* 0 == members.size() */
+     indent(out) << "arbitrary = QC.elements [" <<tname<< "]" << endl;
+  }
+  indent_down();
 }
 
 /**
@@ -576,76 +681,71 @@
   vector<t_field*>::const_iterator f_iter;
 
   string sname = type_name(tstruct);
-  string str = tmp("_str");
-  string t = tmp("_t");
   string id = tmp("_id");
+  string val = tmp("_val");
 
-  indent(out) << "read_" << sname << "_fields iprot record = do" << endl;
+  indent(out) << "to_" << sname << " :: T.ThriftVal -> " << sname << endl;
+  indent(out) << "to_" << sname << " (T.TStruct fields) = " << sname << "{" << endl;
   indent_up();
 
-  // Read beginning field marker
-  indent(out) << "(_," << t << "," << id << ") <- T.readFieldBegin iprot" << endl;
-
-  // Check for field STOP marker and break
-  indent(out) << "if " << t << " P.== T.T_STOP then P.return record else" << endl;
-
-  indent_up();
-  indent(out) << "case " << id << " of " << endl;
-  indent_up();
+  bool first = true;
 
   // Generate deserialization code for known cases
-  for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
-    int32_t key = (*f_iter)->get_key();
-    string etype = type_to_enum((*f_iter)->get_type());
-    indent(out) << key << " -> " << "if " << t << " P.== " << etype << " then do" << endl;
+  for (auto* f_iter : fields) {
+    int32_t key = f_iter->get_key();
+    string etype = type_to_enum(f_iter->get_type());
+    string fname = f_iter->get_name();
 
-    indent_up();
-    indent(out) << "s <- ";
-    generate_deserialize_field(out, *f_iter,str);
-    out << endl;
+    if (first) {
+      first = false;
+    } else {
+      out << "," << endl;
+    }
 
-    string fname = (*f_iter)->get_name();
-    indent(out) << "read_" << sname << "_fields iprot record{f_" << sname << "_" << fname << "=P.Just s}" << endl;
+    // Fill in Field
+    indent(out) << field_name(sname, fname) << " = ";
 
-    indent(out) << "else do" << endl;
+    out << "P.maybe (";
+    if (f_iter->get_req() == t_field::T_REQUIRED) {
+      out << "P.error \"Missing required field: " << fname << "\"";
+    } else {
+      if ((f_iter->get_req() == t_field::T_OPTIONAL ||
+	   ((t_type*)f_iter->get_type())->is_xception()) &&
+	  f_iter->get_value() == nullptr) {
+	out << "P.Nothing";
+      } else {
+        out << field_name(sname, fname) << " default_" << sname;
+      }
+    }
+    out << ") ";
 
-    indent_up();
-    indent(out) << "T.skip iprot " << t << endl;
+    out << "(\\(_," << val << ") -> ";
+    if (f_iter->get_req() == t_field::T_OPTIONAL ||
+	((t_type*)f_iter->get_type())->is_xception())
+      out << "P.Just ";
+    generate_deserialize_field(out, f_iter, val);
+    out << ")";
+    out << " (Map.lookup (" << key << ") fields)";
 
-    indent(out) << "read_" << sname << "_fields iprot record" << endl;
-
-    indent_down();
-    indent_down();
   }
 
-  // In the default case we skip the field
-  indent(out) << "_ -> do" << endl;
-  indent_up();
-  indent(out) << "T.skip iprot " << t << endl;
-  indent(out) << "T.readFieldEnd iprot" << endl;
-  indent(out) << "read_" << sname << "_fields iprot record" << endl;
-  indent_down();
-  indent_down();
-  indent_down();
+  out << endl;
+  indent(out) << "}" << endl;
   indent_down();
 
   // read
-  indent(out) << "read_" << sname << " iprot = do" << endl;
-  indent_up();
-  indent(out) << "_ <- T.readStructBegin iprot" << endl;
-  indent(out) << "record <- read_" << sname << "_fields iprot (" << sname << "{";
+  string tmap = type_name(tstruct, "typemap_");
+  indent(out) << "to_" << sname << " _ = P.error \"not a struct\"" << endl;
 
-  bool first = true;
-  for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
-    out << (first ? "" : ",");
-    out << "f_" << sname << "_" << (*f_iter)->get_name() << "=P.Nothing";
-    first = false;
-  }
+  indent(out) << "read_" << sname <<
+    " :: (T.Transport t, T.Protocol p) => p t -> P.IO " << sname << endl;
+  indent(out) << "read_" << sname << " iprot = to_" << sname;
+  out << " <$> T.readVal iprot (T.T_STRUCT " << tmap << ")" << endl;
 
-  out << "})" << endl;
-  indent(out) << "T.readStructEnd iprot" << endl;
-  indent(out) << "P.return record" << endl;
-  indent_down();
+  indent(out) << "decode_" << sname <<
+    " :: (T.Protocol p, T.Transport t) => p t -> LBS.ByteString -> " << sname << endl;
+  indent(out) << "decode_" << sname << " iprot bs = to_" << sname << " $ ";
+  out << "T.deserializeVal iprot (T.T_STRUCT " << tmap << ") bs" << endl;
 }
 
 void t_hs_generator::generate_hs_struct_writer(ofstream& out,
@@ -655,36 +755,105 @@
   vector<t_field*>::const_iterator f_iter;
   string str = tmp("_str");
   string f = tmp("_f");
+  string v = tmp("_v");
 
-  indent(out) << "write_" << name << " oprot record = do" << endl;
+  indent(out) << "from_" << name << " :: " << name << " -> T.ThriftVal" << endl;
+  indent(out) << "from_" << name << " record = T.TStruct $ Map.fromList ";
   indent_up();
-  indent(out) << "T.writeStructBegin oprot \"" << name << "\"" << endl;
 
-  for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
-    // Write field header
-    string mname = (*f_iter)->get_name();
-    indent(out) << "case f_" << name << "_" << mname << " record of {P.Nothing -> P.return (); P.Just _v -> do" << endl;
+  // Get Exceptions
+  bool hasExn = false;
+  for (auto* f_iter : fields) {
+    if (((t_type*)f_iter->get_type())->is_xception()) {
+      hasExn = true;
+      break;
+    }
+  }
 
-    indent_up();
-    indent(out) << "T.writeFieldBegin oprot (\"" << (*f_iter)->get_name() << "\","
-                << type_to_enum((*f_iter)->get_type()) << ","
-                << (*f_iter)->get_key() << ")" << endl;
-
-    // Write field contents
-    indent(out);
-    generate_serialize_field(out, *f_iter, "_v");
+  bool isfirst = true;
+  if (hasExn) {
     out << endl;
-
-    // Write field closer
-    indent(out) << "T.writeFieldEnd oprot}" << endl;
+    indent(out) << "(let exns = M.catMaybes ";
+    indent_up();
+    for (auto* f_iter : fields) {
+      if (((t_type*)f_iter->get_type())->is_xception()) {
+	if (isfirst) {
+	  out << "[ ";
+	  isfirst = false;
+	} else {
+	  out << ", ";
+	}
+	string mname = f_iter->get_name();
+	int32_t key = f_iter->get_key();
+	out << "(\\" << v << " -> (" << key << ", (\"" << mname << "\",";
+	generate_serialize_type(out, f_iter->get_type(), v);
+	out << "))) <$> " << field_name(name, mname) << " record";
+      }
+    }
+    if (!isfirst) {
+      out << "]" << endl;
+    }
     indent_down();
+    indent(out) << "in if P.not (P.null exns) then exns else ";
+    indent_up();
+  } else {
+    out << "$ ";
+  }
+
+  out << "M.catMaybes" << endl;
+  // Get the Rest
+  isfirst = true;
+  for (auto* f_iter : fields) {
+    // Write field header
+    if (isfirst) {
+      indent(out) << "[ ";
+      isfirst = false;
+    } else {
+      indent(out) << ", ";
+    }
+    string mname = f_iter->get_name();
+    int32_t key = f_iter->get_key();
+    out << "(\\";
+    out << v << " -> ";
+    if (f_iter->get_req() != t_field::T_OPTIONAL &&
+	!((t_type*)f_iter->get_type())->is_xception()) {
+      out << "P.Just ";
+    }
+    out << "(" << key << ", (\"" << mname << "\",";
+    generate_serialize_type(out, f_iter->get_type(), v);
+    out << "))) ";
+    if (f_iter->get_req() != t_field::T_OPTIONAL &&
+	!((t_type*)f_iter->get_type())->is_xception()) {
+      out << "$";
+    } else {
+      out << "<$>";
+    }
+    out << " " << field_name(name, mname) << " record" << endl;
   }
 
   // Write the struct map
-  indent(out) << "T.writeFieldStop oprot" << endl;
-  indent(out) << "T.writeStructEnd oprot" << endl;
-
+  if (isfirst) {
+    indent(out) << "[]" << endl;
+  } else {
+    indent(out) << "]" << endl;
+  }
+  if (hasExn) {
+    indent(out) << ")" << endl;
+    indent_down();
+  }
   indent_down();
+
+  // write
+  indent(out) << "write_" << name << " :: (T.Protocol p, T.Transport t) => p t -> "
+              << name << " -> P.IO ()" << endl;
+  indent(out) << "write_" << name << " oprot record = T.writeVal oprot $ from_";
+  out << name << " record" << endl;
+
+  // encode
+  indent(out) << "encode_" << name << " :: (T.Protocol p, T.Transport t) => p t -> "
+              << name << " -> LBS.ByteString" << endl;
+  indent(out) << "encode_" << name << " oprot record = T.serializeVal oprot $ ";
+  out << "from_" << name << " record" << endl;
 }
 
 /**
@@ -743,7 +912,7 @@
  * @param tfunction The function
  */
 void t_hs_generator::generate_hs_function_helpers(t_function* tfunction) {
-  t_struct result(program_, decapitalize(tfunction->get_name()) + "_result");
+  t_struct result(program_, field_name(tfunction->get_name(), "result"));
   t_field success(tfunction->get_returntype(), "success", 0);
 
   if (!tfunction->get_returntype()->is_void())
@@ -760,6 +929,74 @@
 }
 
 /**
+ * Generate the map from field names to (type, id)
+ * @param tstruct the Struct
+ */
+void t_hs_generator::generate_hs_typemap(ofstream& out,
+                                         t_struct* tstruct) {
+  string name = type_name(tstruct);
+  const auto& fields = tstruct->get_sorted_members();
+  vector<t_field*>::const_iterator f_iter;
+
+  indent(out) << "typemap_" << name << " :: T.TypeMap" << endl;
+  indent(out) << "typemap_" << name << " = Map.fromList [";
+  bool first = true;
+  for (const auto& f_iter : fields) {
+    string mname = f_iter->get_name();
+    if (!first) {
+      out << ",";
+    }
+
+    t_type* type = get_true_type(f_iter->get_type());
+    int32_t key = f_iter->get_key();
+    out << "(" << key << ",(\"" << mname << "\"," << type_to_enum(type) << "))";
+    first = false;
+  }
+  out << "]" << endl;
+}
+
+/**
+ * generate the struct with default values filled in
+ * @param tstruct the Struct
+ */
+void t_hs_generator::generate_hs_default(ofstream& out,
+                                         t_struct* tstruct) {
+  string name = type_name(tstruct);
+  string fname = type_name(tstruct, "default_");
+  const auto& fields = tstruct->get_sorted_members();
+  vector<t_field*>::const_iterator f_iter;
+
+  indent(out) << fname << " :: " << name << endl;
+  indent(out) << fname << " = " << name << "{" << endl;
+  indent_up();
+  bool first = true;
+  for (const auto& f_iter : fields) {
+    string mname = f_iter->get_name();
+    if (first) {
+      first = false;
+    } else {
+      out << "," << endl;
+    }
+
+    t_type* type = get_true_type(f_iter->get_type());
+    t_const_value* value = f_iter->get_value();
+    indent(out) << field_name(name, mname) << " = ";
+    if (f_iter->get_req() == t_field::T_OPTIONAL ||
+	((t_type*)f_iter->get_type())->is_xception()) {
+      if (value == nullptr) {
+        out << "P.Nothing";
+      } else {
+        out << "P.Just " << render_const_value(type, value);
+      }
+    } else {
+      out << render_const_value(type, value);
+    }
+  }
+  out << "}" << endl;
+  indent_down();
+}
+
+/**
  * Generates a service interface definition.
  *
  * @param tservice The service to generate a header definition for
@@ -835,13 +1072,13 @@
     indent(f_client_) << "import " << extends << "_Client" << endl;
   }
 
-  indent(f_client_) << "import qualified Data.IORef as IORef" << endl;
+  indent(f_client_) << "import qualified Data.IORef as R" << endl;
   indent(f_client_) << hs_imports() << endl;
   indent(f_client_) << "import " << capitalize(program_name_) << "_Types" << endl;
   indent(f_client_) << "import " << capitalize(service_name_) << endl;
 
   // DATS RITE A GLOBAL VAR
-  indent(f_client_) << "seqid = IORef.newIORef 0" << endl;
+  indent(f_client_) << "seqid = R.newIORef 0" << endl;
 
   // Generate client method implementations
   for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
@@ -852,7 +1089,7 @@
 
     string fargs = "";
     for (fld_iter = fields.begin(); fld_iter != fields.end(); ++fld_iter)
-      fargs += " arg_" + decapitalize((*fld_iter)->get_name());
+      fargs += " arg_" + (*fld_iter)->get_name();
 
     // Open function
     indent(f_client_) << decapitalize(funname) << " (ip,op)" <<  fargs << " = do" << endl;
@@ -864,13 +1101,14 @@
     if (!(*f_iter)->is_oneway())
       indent(f_client_) << "recv_" << funname << " ip" << endl;
 
+
     indent_down();
 
     indent(f_client_) << "send_" << funname << " op" << fargs << " = do" << endl;
     indent_up();
 
     indent(f_client_) << "seq <- seqid" << endl;
-    indent(f_client_) << "seqn <- IORef.readIORef seq" << endl;
+    indent(f_client_) << "seqn <- R.readIORef seq" << endl;
     string argsname = capitalize((*f_iter)->get_name() + "_args");
 
     // Serialize the request header
@@ -879,16 +1117,20 @@
     indent(f_client_) << "write_" << argsname << " op (" << argsname << "{";
 
     bool first = true;
-    for (fld_iter = fields.begin(); fld_iter != fields.end(); ++fld_iter) {
-      string fieldname = (*fld_iter)->get_name();
+    for (auto& fld_iter : fields) {
+      string fieldname = fld_iter->get_name();
       f_client_ << (first ? "" : ",");
-      f_client_ << "f_" << argsname << "_" << fieldname << "=P.Just arg_" << decapitalize(fieldname);
+      f_client_ << field_name(argsname, fieldname) << "=";
+      if (fld_iter->get_req() == t_field::T_OPTIONAL ||
+	  ((t_type*)fld_iter->get_type())->is_xception())
+        f_client_ << "P.Just ";
+      f_client_ << "arg_" << fieldname;
       first = false;
     }
     f_client_ << "})" << endl;
-
-    // Write to the stream
     indent(f_client_) << "T.writeMessageEnd op" << endl;
+    
+    // Write to the stream
     indent(f_client_) << "T.tFlush (T.getTransport op)" << endl;
     indent_down();
 
@@ -899,56 +1141,31 @@
       string funname = string("recv_") + (*f_iter)->get_name();
       t_function recv_function((*f_iter)->get_returntype(), funname, &noargs);
 
+
       // Open function
       indent(f_client_) << funname << " ip = do" << endl;
       indent_up();
 
-      // TODO(mcslee): Validate message reply here, seq ids etc.
       indent(f_client_) << "(fname, mtype, rseqid) <- T.readMessageBegin ip" << endl;
-      indent(f_client_) << "if mtype P.== T.M_EXCEPTION then do" << endl;
-      indent(f_client_) << "  x <- T.readAppExn ip" << endl;
-      indent(f_client_) << "  T.readMessageEnd ip" << endl;
-      indent(f_client_) << "  Exc.throw x" << endl;
-      indent(f_client_) << "  else P.return ()" << endl;
-
-      t_struct* xs = (*f_iter)->get_xceptions();
-      const vector<t_field*>& xceptions = xs->get_members();
+      indent(f_client_) << "M.when (mtype == T.M_EXCEPTION) $ do { exn <- T.readAppExn ip ; T.readMessageEnd ip ; X.throw exn }" << endl;
 
       indent(f_client_) << "res <- read_" << resultname << " ip" << endl;
       indent(f_client_) << "T.readMessageEnd ip" << endl;
 
-      // Careful, only return _result if not a void function
-      if (!(*f_iter)->get_returntype()->is_void()) {
-        indent(f_client_) << "case f_" << resultname << "_success res of" << endl;
-        indent_up();
+      t_struct* xs = (*f_iter)->get_xceptions();
+      const vector<t_field*>& xceptions = xs->get_members();
 
-        indent(f_client_) << "P.Just v -> P.return v" << endl;
-        indent(f_client_) << "P.Nothing -> do" << endl;
-        indent_up();
+      for (auto x_iter : xceptions) {
+	indent(f_client_) << "P.maybe (P.return ()) X.throw ("
+			  << field_name(resultname, x_iter->get_name())
+			  << " res)" << endl;
       }
 
-      vector<t_field*>::const_iterator x_iter;
-      for (x_iter = xceptions.begin(); x_iter != xceptions.end(); ++x_iter) {
-        string xname = (*x_iter)->get_name();
-        indent(f_client_) << "case f_" << resultname << "_" << xname << " res of" << endl;
-        indent_up();
-
-        indent(f_client_) << "P.Nothing -> P.return ()" << endl;
-        indent(f_client_) << "P.Just _v -> Exc.throw _v" << endl;
-        indent_down();
-      }
-
-      // Careful, only return _result if not a void function
-      if ((*f_iter)->get_returntype()->is_void()) {
-        indent(f_client_) << "P.return ()" << endl;
-
-      } else {
-        string tname = (*f_iter)->get_name();
-        indent(f_client_) << "Exc.throw (T.AppExn T.AE_MISSING_RESULT \"" << tname << " failed: unknown result\")" << endl;
-        indent_down();
-        indent_down();
-      }
-
+      if (!(*f_iter)->get_returntype()->is_void())
+        indent(f_client_) << "P.return $ " << field_name(resultname, "success") << " res" << endl;
+      else
+	indent(f_client_) << "P.return ()" << endl;
+ 
       // Close function
       indent_down();
     }
@@ -986,10 +1203,9 @@
   } else {
     f_service_ << "do" << endl;
     indent_up();
-    indent(f_service_) << "T.skip iprot T.T_STRUCT" << endl;
-    indent(f_service_) << "T.readMessageEnd iprot" << endl;
+    indent(f_service_) << "_ <- T.readVal iprot (T.T_STRUCT Map.empty)" << endl;
     indent(f_service_) << "T.writeMessageBegin oprot (name,T.M_EXCEPTION,seqid)" << endl;
-    indent(f_service_) << "T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN_METHOD (\"Unknown function \" P.++ TL.unpack name))" << endl;
+    indent(f_service_) << "T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN_METHOD (\"Unknown function \" ++ LT.unpack name))" << endl;
     indent(f_service_) << "T.writeMessageEnd oprot" << endl;
     indent(f_service_) << "T.tFlush (T.getTransport oprot)" << endl;
     indent_down();
@@ -1003,10 +1219,33 @@
 
   indent(f_service_) << "(name, typ, seqid) <- T.readMessageBegin iprot" << endl;
   indent(f_service_) << "proc_ handler (iprot,oprot) (name,typ,seqid)" << endl;
+  indent(f_service_) << "T.readMessageEnd iprot" << endl;
   indent(f_service_) << "P.return P.True" << endl;
   indent_down();
 }
 
+bool hasNoArguments(t_function* func) {
+    return (func->get_arglist()->get_members().empty());
+}
+
+string t_hs_generator::render_hs_type_for_function_name(t_type* type) {
+    string type_str = render_hs_type(type, false);
+    int found = -1;
+
+    while (true) {
+        found = type_str.find_first_of("[]. ", found + 1);
+        if (string::npos == size_t(found)) {
+            break;
+        }
+
+        if (type_str[found] == '.')
+            type_str[found] = '_';
+        else
+            type_str[found] = 'Z';
+    }
+    return type_str;
+}
+
 /**
  * Generates a process function definition.
  *
@@ -1029,66 +1268,72 @@
   vector<t_field*>::const_iterator f_iter;
 
   indent(f_service_) << "args <- read_" << argsname << " iprot" << endl;
-  indent(f_service_) << "T.readMessageEnd iprot" << endl;
 
   t_struct* xs = tfunction->get_xceptions();
   const vector<t_field*>& xceptions = xs->get_members();
   vector<t_field*>::const_iterator x_iter;
 
-  size_t n = xceptions.size();
-  if (!tfunction->is_oneway()) {
-    if (!tfunction->get_returntype()->is_void())
-      n++;
-
-    indent(f_service_) << "rs <- P.return (" << resultname;
-
-    for(size_t i = 0; i < n; i++)
-      f_service_ << " P.Nothing";
-
-    f_service_ << ")" << endl;
-  }
-
-  indent(f_service_) << "res <- ";
+  size_t n = xceptions.size() + 1;
   // Try block for a function with exceptions
-  if (xceptions.size() > 0) {
-    for(size_t i = 0; i < xceptions.size(); i++) {
-      f_service_ << "(Exc.catch" << endl;
+  if (n > 0) {
+    for(size_t i = 0; i < n; i++) {
+      indent(f_service_) << "(X.catch" << endl;
       indent_up();
-      indent(f_service_);
     }
   }
 
-  f_service_ << "(do" << endl;
-  indent_up();
+  if (n > 0) {
+    indent(f_service_) << "(do" << endl;
+    indent_up();
+  }
   indent(f_service_);
 
   if (!tfunction->is_oneway() && !tfunction->get_returntype()->is_void())
-    f_service_ << "res <- ";
+    f_service_ << "val <- ";
 
   f_service_ << "Iface." << decapitalize(tfunction->get_name()) << " handler";
   for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter)
-    f_service_ <<  " (f_" << argsname <<  "_" << (*f_iter)->get_name() << " args)";
+    f_service_ << " (" <<
+      field_name(argsname, (*f_iter)->get_name()) << " args)";
 
   if (!tfunction->is_oneway() && !tfunction->get_returntype()->is_void()) {
     f_service_ << endl;
-    indent(f_service_) << "P.return rs{f_" << resultname << "_success= P.Just res}";
+    indent(f_service_) << "let res = default_" << resultname << "{" <<
+      field_name(resultname, "success") << " = val}";
 
   } else if (!tfunction->is_oneway()) {
     f_service_ << endl;
-    indent(f_service_) << "P.return rs";
+    indent(f_service_) << "let res = default_" << resultname;
   }
+  f_service_ << endl;
 
-  f_service_ << ")" << endl;
-  indent_down();
+  // Shortcut out here for oneway functions
+  if (tfunction->is_oneway()) {
+    indent(f_service_) << "P.return ()";
+  } else {
+    indent(f_service_) << "T.writeMessageBegin oprot (\"" << tfunction->get_name() << "\", T.M_REPLY, seqid)" << endl;
+    indent(f_service_) << "write_" << resultname << " oprot res" << endl;
+    indent(f_service_) << "T.writeMessageEnd oprot" << endl;
+    indent(f_service_) << "T.tFlush (T.getTransport oprot)";
+  }
+  if (n > 0) {
+    f_service_ << ")";
+    indent_down();
+  }
+  f_service_ << endl;
 
-  if (xceptions.size() > 0 && !tfunction->is_oneway()) {
+  if (n > 0) {
     for (x_iter = xceptions.begin(); x_iter != xceptions.end(); ++x_iter) {
-      indent(f_service_) << "(\\e  -> " << endl;
+      indent(f_service_) << "(\\e  -> do" << endl;
       indent_up();
 
       if (!tfunction->is_oneway()) {
-        indent(f_service_) << "P.return rs{f_" << resultname << "_" << (*x_iter)->get_name() << " =P.Just e}";
-
+	indent(f_service_) << "let res = default_" << resultname << "{"
+			   << field_name(resultname, (*x_iter)->get_name()) << " = P.Just e}" << endl;
+	indent(f_service_) << "T.writeMessageBegin oprot (\"" << tfunction->get_name() << "\", T.M_REPLY, seqid)" << endl;
+	indent(f_service_ ) << "write_" << resultname << " oprot res" << endl;
+        indent(f_service_) << "T.writeMessageEnd oprot" << endl;
+	indent(f_service_ ) << "T.tFlush (T.getTransport oprot)";
       } else {
         indent(f_service_) << "P.return ()";
       }
@@ -1097,22 +1342,26 @@
       indent_down();
       indent_down();
     }
-  }
+    indent(f_service_) << "((\\_ -> do" << endl;
+    indent_up();
 
-  // Shortcut out here for oneway functions
-  if (tfunction->is_oneway()) {
-    indent(f_service_) << "P.return ()" << endl;
+    if (!tfunction->is_oneway()) {
+      indent(f_service_) << "T.writeMessageBegin oprot (\"" << tfunction->get_name() << "\", T.M_EXCEPTION, seqid)" << endl;
+      indent(f_service_ ) << "T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN \"\")" << endl;
+      indent(f_service_) << "T.writeMessageEnd oprot" << endl;
+      indent(f_service_ ) << "T.tFlush (T.getTransport oprot)";
+    } else {
+      indent(f_service_) << "P.return ()";
+    }
+
+    f_service_ << ") :: X.SomeException -> P.IO ()))" << endl;
     indent_down();
-    return;
+    indent_down();
+      
   }
-
-  indent(f_service_ ) << "T.writeMessageBegin oprot (\"" << tfunction->get_name() << "\", T.M_REPLY, seqid);" << endl;
-  indent(f_service_ ) << "write_" << resultname << " oprot res" << endl;
-  indent(f_service_ ) << "T.writeMessageEnd oprot" << endl;
-  indent(f_service_ ) << "T.tFlush (T.getTransport oprot)" << endl;
-
   // Close function
   indent_down();
+
 }
 
 /**
@@ -1123,66 +1372,41 @@
                                                 string prefix) {
   (void) prefix;
   t_type* type = tfield->get_type();
-  generate_deserialize_type(out,type);
+  generate_deserialize_type(out,type, prefix);
 }
 
 /**
  * Deserializes a field of any type.
  */
 void t_hs_generator::generate_deserialize_type(ofstream &out,
-                                               t_type* type) {
+                                               t_type* type,
+                                               string arg) {
   type = get_true_type(type);
+  string val = tmp("_val");
+  out << "(case " << arg << " of {" << type_to_constructor(type) << " " << val << " -> ";
 
   if (type->is_void())
     throw "CANNOT GENERATE DESERIALIZE CODE FOR void TYPE";
 
   if (type->is_struct() || type->is_xception()) {
-    generate_deserialize_struct(out, (t_struct*)type);
+    generate_deserialize_struct(out, (t_struct*)type, val);
 
   } else if (type->is_container()) {
-    generate_deserialize_container(out, type);
+    generate_deserialize_container(out, type, val);
 
   } else if (type->is_base_type()) {
     t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
-
-    switch (tbase) {
-    case t_base_type::TYPE_VOID:
-      throw "compiler error: cannot serialize void field in a struct";
-      break;
-    case t_base_type::TYPE_STRING:
-      out << (((t_base_type*)type)->is_binary() ? "T.readBinary" : "T.readString");
-      break;
-    case t_base_type::TYPE_BOOL:
-      out << "T.readBool";
-      break;
-    case t_base_type::TYPE_BYTE:
-      out << "T.readByte";
-      break;
-    case t_base_type::TYPE_I16:
-      out << "T.readI16";
-      break;
-    case t_base_type::TYPE_I32:
-      out << "T.readI32";
-      break;
-    case t_base_type::TYPE_I64:
-      out << "T.readI64";
-      break;
-    case t_base_type::TYPE_DOUBLE:
-      out << "T.readDouble";
-      break;
-    default:
-      throw "compiler error: no PHP name for base type " + t_base_type::t_base_name(tbase);
+    if (tbase == t_base_type::TYPE_STRING && !((t_base_type*)type)->is_binary()) {
+      out << "E.decodeUtf8 ";
     }
-    out << " iprot";
-
+    out << val;
   } else if (type->is_enum()) {
-    string ename = capitalize(type->get_name());
-    out << "(do {i <- T.readI32 iprot; P.return P.$ P.toEnum P.$ P.fromIntegral i})";
+    out << "P.toEnum $ P.fromIntegral " << val;
 
   } else {
-    printf("DO NOT KNOW HOW TO DESERIALIZE TYPE '%s'\n",
-           type->get_name().c_str());
+    throw "DO NOT KNOW HOW TO DESERIALIZE TYPE " + type->get_name();
   }
+  out << "; _ -> P.error \"wrong type\"})";
 }
 
 
@@ -1190,10 +1414,10 @@
  * Generates an unserializer for a struct, calling read()
  */
 void t_hs_generator::generate_deserialize_struct(ofstream &out,
-                                                 t_struct* tstruct) {
-  string name = capitalize(tstruct->get_name());
-  string module_name = capitalize(tstruct->get_program()->get_name()) + "_Types";
-  out << "(" << module_name << "." << "read_" << name << " iprot)";
+                                                 t_struct* tstruct,
+                                                 string name) {
+
+  out << "(" << type_name(tstruct, "to_") << " (T.TStruct " << name << "))";
 }
 
 /**
@@ -1201,37 +1425,30 @@
  * data and then a footer.
  */
 void t_hs_generator::generate_deserialize_container(ofstream &out,
-                                                    t_type* ttype) {
-  string size = tmp("_size");
-  string ktype = tmp("_ktype");
-  string vtype = tmp("_vtype");
-  string etype = tmp("_etype");
-  string con = tmp("_con");
+                                                    t_type* ttype,
+                                                    string arg) {
 
-  t_field fsize(g_type_i32, size);
-  t_field fktype(g_type_byte, ktype);
-  t_field fvtype(g_type_byte, vtype);
-  t_field fetype(g_type_byte, etype);
-
+  string val = tmp("_v");
   // Declare variables, read header
   if (ttype->is_map()) {
-    out << "(let {f 0 = P.return []; f n = do {k <- ";
-    generate_deserialize_type(out,((t_map*)ttype)->get_key_type());
+    string key = tmp("_k");
+    out << "(Map.fromList $ P.map (\\(" << key << "," << val << ") -> (";
+    generate_deserialize_type(out,((t_map*)ttype)->get_key_type(),key);
 
-    out << "; v <- ";
-    generate_deserialize_type(out,((t_map*)ttype)->get_val_type());
+    out << ",";
+    generate_deserialize_type(out,((t_map*)ttype)->get_val_type(),val);
 
-    out << ";r <- f (n P.- 1); P.return P.$ (k,v) : r}} in do {(" << ktype << "," << vtype << "," << size << ") <- T.readMapBegin iprot; l <- f " << size << "; P.return P.$ Map.fromList l})";
+    out << ")) " << arg << ")";
 
   } else if (ttype->is_set()) {
-    out << "(let {f 0 = P.return []; f n = do {v <- ";
-    generate_deserialize_type(out,((t_map*)ttype)->get_key_type());
-    out << ";r <- f (n P.- 1); P.return P.$ v : r}} in do {(" << etype << "," << size << ") <- T.readSetBegin iprot; l <- f " << size << "; P.return P.$ Set.fromList l})";
+    out << "(Set.fromList $ P.map (\\" << val << " -> ";
+    generate_deserialize_type(out,((t_map*)ttype)->get_key_type(),val);
+    out << ") " << arg << ")";
 
   } else if (ttype->is_list()) {
-    out << "(let f n = Vector.replicateM (P.fromIntegral n) (";
-    generate_deserialize_type(out,((t_map*)ttype)->get_key_type());
-    out << ") in do {(" << etype << "," << size << ") <- T.readListBegin iprot; f " << size << "})";
+    out << "(Vector.fromList $ P.map (\\" << val << " -> ";
+    generate_deserialize_type(out,((t_map*)ttype)->get_key_type(),val);
+    out << ") " << arg << ")";
   }
 }
 
@@ -1241,17 +1458,14 @@
  * @param tfield The field to serialize
  * @param prefix Name to prepend to field name
  */
-void t_hs_generator::generate_serialize_field(ofstream &out,
-                                              t_field* tfield,
+void t_hs_generator::generate_serialize_type(ofstream &out,
+                                              t_type* type,
                                               string name) {
-  t_type* type = get_true_type(tfield->get_type());
 
+  type = get_true_type(type);
   // Do nothing for void types
   if (type->is_void())
-    throw "CANNOT GENERATE SERIALIZE CODE FOR void TYPE: " + tfield->get_name();
-
-  if (name.length() == 0)
-    name = decapitalize(tfield->get_name());
+    throw "CANNOT GENERATE SERIALIZE CODE FOR void TYPE";
 
   if (type->is_struct() || type->is_xception()) {
     generate_serialize_struct(out, (t_struct*)type, name);
@@ -1262,53 +1476,19 @@
   } else if (type->is_base_type() || type->is_enum()) {
     if (type->is_base_type()) {
       t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
-      switch (tbase) {
-      case t_base_type::TYPE_VOID:
-        throw
-          "compiler error: cannot serialize void field in a struct: " + name;
-        break;
-
-      case t_base_type::TYPE_STRING:
-        out << (((t_base_type*)type)->is_binary() ? "T.writeBinary" : "T.writeString") << " oprot " << name;
-        break;
-
-      case t_base_type::TYPE_BOOL:
-        out << "T.writeBool oprot " << name;
-       break;
-
-      case t_base_type::TYPE_BYTE:
-        out << "T.writeByte oprot " << name;
-        break;
-
-      case t_base_type::TYPE_I16:
-        out << "T.writeI16 oprot " << name;
-        break;
-
-      case t_base_type::TYPE_I32:
-        out << "T.writeI32 oprot " << name;
-        break;
-
-      case t_base_type::TYPE_I64:
-        out << "T.writeI64 oprot " << name;
-        break;
-
-      case t_base_type::TYPE_DOUBLE:
-        out << "T.writeDouble oprot " << name;
-        break;
-
-      default:
-        throw "compiler error: no hs name for base type " + t_base_type::t_base_name(tbase);
+      out << type_to_constructor(type) << " ";
+      if (tbase == t_base_type::TYPE_STRING && !((t_base_type*)type)->is_binary()) {
+        out << "$ E.encodeUtf8 ";
       }
+      out << name;
 
     } else if (type->is_enum()) {
       string ename = capitalize(type->get_name());
-      out << "T.writeI32 oprot (P.fromIntegral P.$ P.fromEnum " << name << ")";
+      out << "T.TI32 $ P.fromIntegral $ P.fromEnum " << name;
     }
 
   } else {
-    printf("DO NOT KNOW HOW TO SERIALIZE FIELD '%s' TYPE '%s'\n",
-           tfield->get_name().c_str(),
-           type->get_name().c_str());
+    throw "DO NOT KNOW HOW TO SERIALIZE FIELD OF TYPE " + type->get_name();
   }
 }
 
@@ -1321,80 +1501,50 @@
 void t_hs_generator::generate_serialize_struct(ofstream &out,
                                                t_struct* tstruct,
                                                string prefix) {
-  out << type_name(tstruct, "write_") << " oprot " << prefix;
+  out << type_name(tstruct, "from_") << " " << prefix;
 }
 
 void t_hs_generator::generate_serialize_container(ofstream &out,
                                                   t_type* ttype,
                                                   string prefix) {
+  string k = tmp("_k");
+  string v = tmp("_v");
+
   if (ttype->is_map()) {
-    string k = tmp("_kiter");
-    string v = tmp("_viter");
-    out << "(let {f [] = P.return (); f ((" << k << "," << v << "):t) = do {";
-    generate_serialize_map_element(out, (t_map*)ttype, k, v);
-    out << ";f t}} in do {T.writeMapBegin oprot (" << type_to_enum(((t_map*)ttype)->get_key_type()) << "," << type_to_enum(((t_map*)ttype)->get_val_type()) << ",P.fromIntegral P.$ Map.size " << prefix << "); f (Map.toList " << prefix << ");T.writeMapEnd oprot})";
+    t_type* ktype = ((t_map*)ttype)->get_key_type();
+    t_type* vtype = ((t_map*)ttype)->get_val_type();
+    out << "T.TMap " << type_to_enum(ktype) << " " << type_to_enum(vtype);
+    out << " $ P.map (\\(" << k << "," << v << ") -> (";
+    generate_serialize_type(out, ktype, k);
+    out << ", ";
+    generate_serialize_type(out, vtype, v);
+    out << ")) $ Map.toList " << prefix;
 
   } else if (ttype->is_set()) {
-    string v = tmp("_viter");
-    out << "(let {f [] = P.return (); f (" << v << ":t) = do {";
-    generate_serialize_set_element(out, (t_set*)ttype, v);
-    out << ";f t}} in do {T.writeSetBegin oprot (" << type_to_enum(((t_set*)ttype)->get_elem_type()) << ",P.fromIntegral P.$ Set.size " << prefix << "); f (Set.toList " << prefix << ");T.writeSetEnd oprot})";
+    out << "T.TSet " << type_to_enum(((t_list*)ttype)->get_elem_type());
+    out <<" $ P.map (\\" << v << " -> ";
+    generate_serialize_type(out, ((t_list*)ttype)->get_elem_type(), v);
+    out << ") $ Set.toList " << prefix;
 
   } else if (ttype->is_list()) {
-    string v = tmp("_viter");
-    out << "(let f = Vector.mapM_ (\\" << v << " -> ";
-    generate_serialize_list_element(out, (t_list*)ttype, v);
-    out << ") in do {T.writeListBegin oprot (" << type_to_enum(((t_list*)ttype)->get_elem_type()) << ",P.fromIntegral P.$ Vector.length " << prefix << "); f " << prefix << ";T.writeListEnd oprot})";
+    out << "T.TList " << type_to_enum(((t_list*)ttype)->get_elem_type());
+    out <<" $ P.map (\\" << v << " -> ";
+    generate_serialize_type(out, ((t_list*)ttype)->get_elem_type(), v);
+    out << ") $ Vector.toList " << prefix;
   }
 
 }
 
-/**
- * Serializes the members of a map.
- *
- */
-void t_hs_generator::generate_serialize_map_element(ofstream &out,
-                                                    t_map* tmap,
-                                                    string kiter,
-                                                    string viter) {
-  t_field kfield(tmap->get_key_type(), kiter);
-  out << "do {";
-  generate_serialize_field(out, &kfield);
-  out << ";";
-
-  t_field vfield(tmap->get_val_type(), viter);
-  generate_serialize_field(out, &vfield);
-  out << "}";
-}
-
-/**
- * Serializes the members of a set.
- */
-void t_hs_generator::generate_serialize_set_element(ofstream &out,
-                                                    t_set* tset,
-                                                    string iter) {
-  t_field efield(tset->get_elem_type(), iter);
-  generate_serialize_field(out, &efield);
-}
-
-/**
- * Serializes the members of a list.
- */
-void t_hs_generator::generate_serialize_list_element(ofstream &out,
-                                                     t_list* tlist,
-                                                     string iter) {
-  t_field efield(tlist->get_elem_type(), iter);
-  generate_serialize_field(out, &efield);
-}
-
 string t_hs_generator::function_type(t_function* tfunc, bool options, bool io, bool method) {
   string result = "";
 
   const vector<t_field*>& fields = tfunc->get_arglist()->get_members();
   vector<t_field*>::const_iterator f_iter;
-  for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
-    if (options) result += "P.Maybe ";
-    result += render_hs_type((*f_iter)->get_type(), options);
+  for (auto& f_iter : fields) {
+    if (f_iter->get_req() == t_field::T_OPTIONAL ||
+	((t_type*)f_iter->get_type())->is_xception())
+      result += "P.Maybe ";
+    result += render_hs_type(f_iter->get_type(), options);
     result += " -> ";
   }
 
@@ -1420,6 +1570,10 @@
   return prefix + function_prefix + capitalize(ttype->get_name());
 }
 
+string t_hs_generator::field_name(string tname, string fname) {
+  return decapitalize(tname) + "_" + fname;
+}
+
 /**
  * Converts the parse type to a Protocol.t_type enum
  */
@@ -1443,22 +1597,63 @@
     return "T.T_I32";
 
   } else if (type->is_struct() || type->is_xception()) {
-    return "T.T_STRUCT";
+    return "(T.T_STRUCT " + type_name((t_struct*)type, "typemap_") + ")";
 
   } else if (type->is_map()) {
-    return "T.T_MAP";
+    string ktype = type_to_enum(((t_map*)type)->get_key_type());
+    string vtype = type_to_enum(((t_map*)type)->get_val_type());
+    return "(T.T_MAP " + ktype + " " + vtype + ")";
 
   } else if (type->is_set()) {
-    return "T.T_SET";
+    return "(T.T_SET " + type_to_enum(((t_list*)type)->get_elem_type()) + ")";
 
   } else if (type->is_list()) {
-    return "T.T_LIST";
+    return "(T.T_LIST " + type_to_enum(((t_list*)type)->get_elem_type()) + ")";
   }
 
   throw "INVALID TYPE IN type_to_enum: " + type->get_name();
 }
 
 /**
+ * Converts the parse type to a default value
+ */
+string t_hs_generator::type_to_default(t_type* type) {
+  type = get_true_type(type);
+
+  if (type->is_base_type()) {
+    t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
+    switch (tbase) {
+    case t_base_type::TYPE_VOID:   return "P.error \"No default value for type T_VOID\"";
+    case t_base_type::TYPE_STRING: return "\"\"";
+    case t_base_type::TYPE_BOOL:   return "P.False";
+    case t_base_type::TYPE_BYTE:   return "0";
+    case t_base_type::TYPE_I16:    return "0";
+    case t_base_type::TYPE_I32:    return "0";
+    case t_base_type::TYPE_I64:    return "0";
+    case t_base_type::TYPE_DOUBLE: return "0";
+    }
+
+  } else if (type->is_enum()) {
+    return "(P.toEnum 0)";
+
+  } else if (type->is_struct() || type->is_xception()) {
+    return type_name((t_struct*)type, "default_");
+
+  } else if (type->is_map()) {
+    return "Map.empty";
+
+  } else if (type->is_set()) {
+    return "Set.empty";
+
+  } else if (type->is_list()) {
+    return "Vector.empty";
+  }
+
+  throw "INVALID TYPE IN type_to_default: " + type->get_name();
+}
+
+
+/**
  * Converts the parse type to an haskell type
  */
 string t_hs_generator::render_hs_type(t_type* type, bool needs_parens) {
@@ -1469,7 +1664,7 @@
     t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
     switch (tbase) {
     case t_base_type::TYPE_VOID:   return "()";
-    case t_base_type::TYPE_STRING: return (((t_base_type*)type)->is_binary() ? "BL.ByteString" : "TL.Text");
+    case t_base_type::TYPE_STRING: return (((t_base_type*)type)->is_binary() ? "LBS.ByteString" : "LT.Text");
     case t_base_type::TYPE_BOOL:   return "P.Bool";
     case t_base_type::TYPE_BYTE:   return "I.Int8";
     case t_base_type::TYPE_I16:    return "I.Int16";
@@ -1504,4 +1699,42 @@
   return needs_parens ? "(" + type_repr + ")" : type_repr;
 }
 
+/**
+ * Converts the parse type to a haskell constructor
+ */
+string t_hs_generator::type_to_constructor(t_type* type) {
+  type = get_true_type(type);
+
+  if (type->is_base_type()) {
+    t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
+    switch (tbase) {
+    case t_base_type::TYPE_VOID:   throw "invalid type: T_VOID";
+    case t_base_type::TYPE_STRING: return "T.TString";
+    case t_base_type::TYPE_BOOL:   return "T.TBool";
+    case t_base_type::TYPE_BYTE:   return "T.TByte";
+    case t_base_type::TYPE_I16:    return "T.TI16";
+    case t_base_type::TYPE_I32:    return "T.TI32";
+    case t_base_type::TYPE_I64:    return "T.TI64";
+    case t_base_type::TYPE_DOUBLE: return "T.TDouble";
+    }
+
+  } else if (type->is_enum()) {
+    return "T.TI32";
+
+  } else if (type->is_struct() || type->is_xception()) {
+    return "T.TStruct";
+
+  } else if (type->is_map()) {
+    return "T.TMap _ _";
+
+  } else if (type->is_set()) {
+    return "T.TSet _";
+
+  } else if (type->is_list()) {
+    return "T.TList _";
+  }
+  throw "INVALID TYPE IN type_to_enum: " + type->get_name();
+}
+
+
 THRIFT_REGISTER_GENERATOR(hs, "Haskell", "")
diff --git a/lib/hs/LICENSE b/lib/hs/LICENSE
old mode 100644
new mode 100755
diff --git a/lib/hs/Makefile.am b/lib/hs/Makefile.am
old mode 100644
new mode 100755
diff --git a/lib/hs/README.md b/lib/hs/README.md
old mode 100644
new mode 100755
diff --git a/lib/hs/Setup.lhs b/lib/hs/Setup.lhs
old mode 100644
new mode 100755
diff --git a/lib/hs/TODO b/lib/hs/TODO
old mode 100644
new mode 100755
diff --git a/lib/hs/Thrift.cabal b/lib/hs/Thrift.cabal
index b659292..f847663 100755
--- a/lib/hs/Thrift.cabal
+++ b/lib/hs/Thrift.cabal
@@ -19,7 +19,7 @@
 
 Name:           thrift
 Version:        1.0.0-dev
-Cabal-Version:  >= 1.4
+Cabal-Version:  >= 1.8
 License:        OtherLicense
 Category:       Foreign
 Build-Type:     Simple
@@ -36,16 +36,20 @@
   Hs-Source-Dirs:
     src
   Build-Depends:
-    base >= 4, base < 5, network, ghc-prim, binary, bytestring, hashable, HTTP, text, unordered-containers, vector
+    base >= 4, base < 5, containers, network, ghc-prim, attoparsec, binary, bytestring >= 0.10, hashable, HTTP, text, unordered-containers, vector, QuickCheck
   Exposed-Modules:
     Thrift,
+    Thrift.Arbitraries
     Thrift.Protocol,
     Thrift.Protocol.Binary,
+    Thrift.Protocol.Compact,
+    Thrift.Protocol.JSON,
     Thrift.Server,
     Thrift.Transport,
     Thrift.Transport.Framed,
     Thrift.Transport.Handle,
     Thrift.Transport.HttpClient,
+    Thrift.Transport.IOBuffer,
     Thrift.Types
   Extensions:
     DeriveDataTypeable,
@@ -54,5 +58,16 @@
     KindSignatures,
     MagicHash,
     RankNTypes,
+    RecordWildCards,
     ScopedTypeVariables,
     TypeSynonymInstances
+
+Test-Suite tests
+  Type:
+    exitcode-stdio-1.0
+  Hs-Source-Dirs:
+    tests
+  Build-Depends:
+    base, QuickCheck, binary, bytestring, thrift
+  Main-Is:
+    JSONTests.hs
\ No newline at end of file
diff --git a/lib/hs/src/Thrift.hs b/lib/hs/src/Thrift.hs
index 65a2208..58a304b 100644
--- a/lib/hs/src/Thrift.hs
+++ b/lib/hs/src/Thrift.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 --
@@ -31,15 +30,17 @@
     , ThriftException(..)
     ) where
 
-import Control.Monad ( when )
 import Control.Exception
 
-import Data.Text.Lazy ( pack, unpack )
+import Data.Int
+import Data.Text.Lazy ( Text, pack, unpack )
+import Data.Text.Lazy.Encoding
 import Data.Typeable ( Typeable )
+import qualified Data.HashMap.Strict as Map
 
-import Thrift.Transport
 import Thrift.Protocol
-
+import Thrift.Transport
+import Thrift.Types
 
 data ThriftException = ThriftException
   deriving ( Show, Typeable )
@@ -90,44 +91,24 @@
 instance Exception AppExn
 
 writeAppExn :: (Protocol p, Transport t) => p t -> AppExn -> IO ()
-writeAppExn pt ae = do
-    writeStructBegin pt "TApplicationException"
-
-    when (ae_message ae /= "") $ do
-        writeFieldBegin pt ("message", T_STRING , 1)
-        writeString pt (pack $ ae_message ae)
-        writeFieldEnd pt
-
-    writeFieldBegin pt ("type", T_I32, 2);
-    writeI32 pt (fromIntegral $ fromEnum (ae_type ae))
-    writeFieldEnd pt
-    writeFieldStop pt
-    writeStructEnd pt
+writeAppExn pt ae = writeVal pt $ TStruct $ Map.fromList
+                    [ (1, ("message", TString $ encodeUtf8 $ pack $ ae_message ae))
+                    , (2, ("type", TI32 $ fromIntegral $ fromEnum (ae_type ae)))
+                    ]
 
 readAppExn :: (Protocol p, Transport t) => p t -> IO AppExn
 readAppExn pt = do
-    _ <- readStructBegin pt
-    record <- readAppExnFields pt (AppExn {ae_type = undefined, ae_message = undefined})
-    readStructEnd pt
-    return record
+    let typemap = Map.fromList [(1,("message",T_STRING)),(2,("type",T_I32))]
+    TStruct fields <- readVal pt $ T_STRUCT typemap
+    return $ readAppExnFields fields
 
-readAppExnFields :: forall (a :: * -> *) t. (Protocol a, Transport t) => a t -> AppExn -> IO AppExn 
-readAppExnFields pt record = do
-    (_, ft, tag) <- readFieldBegin pt
-    if ft == T_STOP
-        then return record
-        else case tag of
-                 1 -> if ft == T_STRING then
-                          do s <- readString pt
-                             readAppExnFields pt record{ae_message = unpack s}
-                          else do skip pt ft
-                                  readAppExnFields pt record
-                 2 -> if ft == T_I32 then
-                          do i <- readI32 pt
-                             readAppExnFields pt record{ae_type = (toEnum $ fromIntegral i)}
-                          else do skip pt ft
-                                  readAppExnFields pt record
-                 _ -> do skip pt ft
-                         readFieldEnd pt
-                         readAppExnFields pt record
-
+readAppExnFields :: Map.HashMap Int16 (Text, ThriftVal) -> AppExn
+readAppExnFields fields = AppExn{
+  ae_message = maybe undefined unwrapMessage $ Map.lookup 1 fields,
+  ae_type    = maybe undefined unwrapType $ Map.lookup 2 fields
+  }
+  where
+    unwrapMessage (_, TString s) = unpack $ decodeUtf8 s
+    unwrapMessage _ = undefined
+    unwrapType (_, TI32 i) = toEnum $ fromIntegral i
+    unwrapType _ = undefined
diff --git a/lib/hs/src/Thrift/Arbitraries.hs b/lib/hs/src/Thrift/Arbitraries.hs
new file mode 100644
index 0000000..3a60ed2
--- /dev/null
+++ b/lib/hs/src/Thrift/Arbitraries.hs
@@ -0,0 +1,61 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Thrift.Arbitraries where
+
+import Data.Bits()
+
+import Test.QuickCheck.Arbitrary
+
+import Control.Applicative ((<$>))
+import Data.Map (Map)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified Data.Vector as Vector
+import qualified Data.Text.Lazy as Text
+import qualified Data.HashSet as HSet
+import qualified Data.HashMap.Strict as HMap
+import Data.Hashable (Hashable)
+
+import Data.ByteString.Lazy (ByteString)
+import qualified Data.ByteString.Lazy as BS
+
+-- String has an Arbitrary instance already
+-- Bool has an Arbitrary instance already
+-- A Thrift 'list' is a Vector.
+
+instance Arbitrary ByteString where
+  arbitrary = BS.pack . filter (/= 0) <$> arbitrary
+
+instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map k v) where
+  arbitrary = Map.fromList <$> arbitrary
+
+instance (Ord k, Arbitrary k) => Arbitrary (Set.Set k) where
+  arbitrary = Set.fromList <$> arbitrary
+
+instance (Arbitrary k) => Arbitrary (Vector.Vector k) where
+  arbitrary = Vector.fromList <$> arbitrary
+
+instance Arbitrary Text.Text where
+  arbitrary = Text.pack . filter (/= '\0') <$> arbitrary
+
+instance (Eq k, Hashable k, Arbitrary k) => Arbitrary (HSet.HashSet k) where
+  arbitrary = HSet.fromList <$> arbitrary
+
+instance (Eq k, Hashable k, Arbitrary k, Arbitrary v) =>
+    Arbitrary (HMap.HashMap k v) where
+  arbitrary = HMap.fromList <$> arbitrary
+
+{-
+   To handle Thrift 'enum' we would ideally use something like:
+
+instance (Enum a, Bounded a) => Arbitrary a
+    where arbitrary = elements (enumFromTo minBound maxBound)
+
+Unfortunately this doesn't play nicely with the type system.
+Instead we'll generate an arbitrary instance along with the code.
+-}
+
+{-
+    There might be some way to introspect on the Haskell structure of a
+    Thrift 'struct' or 'exception' but generating the code directly is simpler.
+-}
diff --git a/lib/hs/src/Thrift/Protocol.hs b/lib/hs/src/Thrift/Protocol.hs
index 6068d16..ea58642 100644
--- a/lib/hs/src/Thrift/Protocol.hs
+++ b/lib/hs/src/Thrift/Protocol.hs
@@ -1,4 +1,6 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
 --
 -- Licensed to the Apache Software Foundation (ASF) under one
 -- or more contributor license agreements. See the NOTICE file
@@ -20,167 +22,58 @@
 
 module Thrift.Protocol
     ( Protocol(..)
-    , skip
-    , MessageType(..)
-    , ThriftType(..)
     , ProtocolExn(..)
     , ProtocolExnType(..)
+    , getTypeOf
+    , runParser
+    , versionMask
+    , version1
+    , bsToDouble
     ) where
 
-import Control.Monad ( replicateM_, unless )
 import Control.Exception
-import Data.ByteString.Lazy
+import Data.Attoparsec.ByteString
+import Data.Bits
+import Data.ByteString.Lazy (ByteString, toStrict)
+import Data.ByteString.Unsafe
+import Data.Functor ((<$>))
 import Data.Int
-import Data.Text.Lazy ( Text )
-import Data.Typeable ( Typeable )
+import Data.Monoid (mempty)
+import Data.Text.Lazy (Text)
+import Data.Typeable (Typeable)
+import Data.Word
+import Foreign.Ptr (castPtr)
+import Foreign.Storable (Storable, peek, poke)
+import System.IO.Unsafe
+import qualified Data.ByteString as BS
+import qualified Data.HashMap.Strict as Map
 
+import Thrift.Types
 import Thrift.Transport
 
+versionMask :: Int32
+versionMask = fromIntegral (0xffff0000 :: Word32)
 
-data ThriftType
-    = T_STOP
-    | T_VOID
-    | T_BOOL
-    | T_BYTE
-    | T_DOUBLE
-    | T_I16
-    | T_I32
-    | T_I64
-    | T_STRING
-    | T_STRUCT
-    | T_MAP
-    | T_SET
-    | T_LIST
-      deriving ( Eq )
-
-instance Enum ThriftType where
-    fromEnum T_STOP   = 0
-    fromEnum T_VOID   = 1
-    fromEnum T_BOOL   = 2
-    fromEnum T_BYTE   = 3
-    fromEnum T_DOUBLE = 4
-    fromEnum T_I16    = 6
-    fromEnum T_I32    = 8
-    fromEnum T_I64    = 10
-    fromEnum T_STRING = 11
-    fromEnum T_STRUCT = 12
-    fromEnum T_MAP    = 13
-    fromEnum T_SET    = 14
-    fromEnum T_LIST   = 15
-
-    toEnum 0  = T_STOP
-    toEnum 1  = T_VOID
-    toEnum 2  = T_BOOL
-    toEnum 3  = T_BYTE
-    toEnum 4  = T_DOUBLE
-    toEnum 6  = T_I16
-    toEnum 8  = T_I32
-    toEnum 10 = T_I64
-    toEnum 11 = T_STRING
-    toEnum 12 = T_STRUCT
-    toEnum 13 = T_MAP
-    toEnum 14 = T_SET
-    toEnum 15 = T_LIST
-    toEnum t = error $ "Invalid ThriftType " ++ show t
-
-data MessageType
-    = M_CALL
-    | M_REPLY
-    | M_EXCEPTION
-      deriving ( Eq )
-
-instance Enum MessageType where
-    fromEnum M_CALL      =  1
-    fromEnum M_REPLY     =  2
-    fromEnum M_EXCEPTION =  3
-
-    toEnum 1 = M_CALL
-    toEnum 2 = M_REPLY
-    toEnum 3 = M_EXCEPTION
-    toEnum t = error $ "Invalid MessageType " ++ show t
-
+version1 :: Int32
+version1 = fromIntegral (0x80010000 :: Word32)
 
 class Protocol a where
-    getTransport :: Transport t => a t -> t
+  getTransport :: Transport t => a t -> t
 
-    writeMessageBegin :: Transport t => a t -> (Text, MessageType, Int32) -> IO ()
-    writeMessageEnd   :: Transport t => a t -> IO ()
+  writeMessageBegin :: Transport t => a t -> (Text, MessageType, Int32) -> IO ()
+  writeMessageEnd :: Transport t => a t -> IO ()
+  writeMessageEnd _ = return ()
+  
+  readMessageBegin :: Transport t => a t -> IO (Text, MessageType, Int32)
+  readMessageEnd :: Transport t => a t -> IO ()
+  readMessageEnd _ = return ()
 
-    writeStructBegin :: Transport t => a t -> Text -> IO ()
-    writeStructEnd   :: Transport t => a t -> IO ()
-    writeFieldBegin  :: Transport t => a t -> (Text, ThriftType, Int16) -> IO ()
-    writeFieldEnd    :: Transport t => a t -> IO ()
-    writeFieldStop   :: Transport t => a t -> IO ()
-    writeMapBegin    :: Transport t => a t -> (ThriftType, ThriftType, Int32) -> IO ()
-    writeMapEnd      :: Transport t => a t -> IO ()
-    writeListBegin   :: Transport t => a t -> (ThriftType, Int32) -> IO ()
-    writeListEnd     :: Transport t => a t -> IO ()
-    writeSetBegin    :: Transport t => a t -> (ThriftType, Int32) -> IO ()
-    writeSetEnd      :: Transport t => a t -> IO ()
+  serializeVal :: Transport t => a t -> ThriftVal -> ByteString
+  deserializeVal :: Transport t => a t -> ThriftType -> ByteString -> ThriftVal
 
-    writeBool   :: Transport t => a t -> Bool -> IO ()
-    writeByte   :: Transport t => a t -> Int8 -> IO ()
-    writeI16    :: Transport t => a t -> Int16 -> IO ()
-    writeI32    :: Transport t => a t -> Int32 -> IO ()
-    writeI64    :: Transport t => a t -> Int64 -> IO ()
-    writeDouble :: Transport t => a t -> Double -> IO ()
-    writeString :: Transport t => a t -> Text -> IO ()
-    writeBinary :: Transport t => a t -> ByteString -> IO ()
-
-
-    readMessageBegin :: Transport t => a t -> IO (Text, MessageType, Int32)
-    readMessageEnd   :: Transport t => a t -> IO ()
-
-    readStructBegin :: Transport t => a t -> IO Text
-    readStructEnd   :: Transport t => a t -> IO ()
-    readFieldBegin  :: Transport t => a t -> IO (Text, ThriftType, Int16)
-    readFieldEnd    :: Transport t => a t -> IO ()
-    readMapBegin    :: Transport t => a t -> IO (ThriftType, ThriftType, Int32)
-    readMapEnd      :: Transport t => a t -> IO ()
-    readListBegin   :: Transport t => a t -> IO (ThriftType, Int32)
-    readListEnd     :: Transport t => a t -> IO ()
-    readSetBegin    :: Transport t => a t -> IO (ThriftType, Int32)
-    readSetEnd      :: Transport t => a t -> IO ()
-
-    readBool   :: Transport t => a t -> IO Bool
-    readByte   :: Transport t => a t -> IO Int8
-    readI16    :: Transport t => a t -> IO Int16
-    readI32    :: Transport t => a t -> IO Int32
-    readI64    :: Transport t => a t -> IO Int64
-    readDouble :: Transport t => a t -> IO Double
-    readString :: Transport t => a t -> IO Text
-    readBinary :: Transport t => a t -> IO ByteString
-
-
-skip :: (Protocol p, Transport t) => p t -> ThriftType -> IO ()
-skip _ T_STOP = return ()
-skip _ T_VOID = return ()
-skip p T_BOOL = readBool p >> return ()
-skip p T_BYTE = readByte p >> return ()
-skip p T_I16 = readI16 p >> return ()
-skip p T_I32 = readI32 p >> return ()
-skip p T_I64 = readI64 p >> return ()
-skip p T_DOUBLE = readDouble p >> return ()
-skip p T_STRING = readString p >> return ()
-skip p T_STRUCT = do _ <- readStructBegin p
-                     skipFields p
-                     readStructEnd p
-skip p T_MAP = do (k, v, s) <- readMapBegin p
-                  replicateM_ (fromIntegral s) (skip p k >> skip p v)
-                  readMapEnd p
-skip p T_SET = do (t, n) <- readSetBegin p
-                  replicateM_ (fromIntegral n) (skip p t)
-                  readSetEnd p
-skip p T_LIST = do (t, n) <- readListBegin p
-                   replicateM_ (fromIntegral n) (skip p t)
-                   readListEnd p
-
-
-skipFields :: (Protocol p, Transport t) => p t -> IO ()
-skipFields p = do
-    (_, t, _) <- readFieldBegin p
-    unless (t == T_STOP) (skip p t >> readFieldEnd p >> skipFields p)
-
+  writeVal :: Transport t => a t -> ThriftVal -> IO ()
+  writeVal p = tWrite (getTransport p) . serializeVal p
+  readVal :: Transport t => a t -> ThriftType -> IO ThriftVal
 
 data ProtocolExnType
     = PE_UNKNOWN
@@ -189,9 +82,63 @@
     | PE_SIZE_LIMIT
     | PE_BAD_VERSION
     | PE_NOT_IMPLEMENTED
-    | PE_DEPTH_LIMIT
+    | PE_MISSING_REQUIRED_FIELD
       deriving ( Eq, Show, Typeable )
 
 data ProtocolExn = ProtocolExn ProtocolExnType String
   deriving ( Show, Typeable )
 instance Exception ProtocolExn
+
+getTypeOf :: ThriftVal -> ThriftType
+getTypeOf v =  case v of
+  TStruct{} -> T_STRUCT Map.empty
+  TMap{} -> T_MAP T_VOID T_VOID
+  TList{} -> T_LIST T_VOID
+  TSet{} -> T_SET T_VOID
+  TBool{} -> T_BOOL
+  TByte{} -> T_BYTE
+  TI16{} -> T_I16
+  TI32{} -> T_I32
+  TI64{} -> T_I64
+  TString{} -> T_STRING
+  TDouble{} -> T_DOUBLE
+
+runParser :: (Protocol p, Transport t, Show a) => p t -> Parser a -> IO a
+runParser prot p = refill >>= getResult . parse p
+  where
+    refill = handle handleEOF $ toStrict <$> tRead (getTransport prot) 1
+    getResult (Done _ a) = return a
+    getResult (Partial k) = refill >>= getResult . k
+    getResult f = throw $ ProtocolExn PE_INVALID_DATA (show f)
+
+handleEOF :: SomeException -> IO BS.ByteString
+handleEOF = const $ return mempty
+
+-- | Converts a ByteString to a Floating point number
+-- The ByteString is assumed to be encoded in network order (Big Endian)
+-- therefore the behavior of this function varies based on whether the local
+-- machine is big endian or little endian.
+bsToDouble :: BS.ByteString -> Double
+bsToDouble bs = unsafeDupablePerformIO $ unsafeUseAsCString bs castBs
+  where
+#if __BYTE_ORDER == __LITTLE_ENDIAN
+    castBs chrPtr = do
+      w <- peek (castPtr chrPtr)
+      poke (castPtr chrPtr) (byteSwap w)
+      peek (castPtr chrPtr)
+#else
+    castBs = peek . castPtr
+#endif
+
+#if __BYTE_ORDER == __LITTLE_ENDIAN
+-- | Swap endianness of a 64-bit word
+byteSwap :: Word64 -> Word64
+byteSwap w = (w `shiftL` 56 .&. 0xFF00000000000000) .|.
+             (w `shiftL` 40 .&. 0x00FF000000000000) .|.
+             (w `shiftL` 24 .&. 0x0000FF0000000000) .|.
+             (w `shiftL` 8  .&. 0x000000FF00000000) .|.
+             (w `shiftR` 8  .&. 0x00000000FF000000) .|.
+             (w `shiftR` 24 .&. 0x0000000000FF0000) .|.
+             (w `shiftR` 40 .&. 0x000000000000FF00) .|.
+             (w `shiftR` 56 .&. 0x00000000000000FF)
+#endif
diff --git a/lib/hs/src/Thrift/Protocol/Binary.hs b/lib/hs/src/Thrift/Protocol/Binary.hs
index 1bc9add..ac78483 100644
--- a/lib/hs/src/Thrift/Protocol/Binary.hs
+++ b/lib/hs/src/Thrift/Protocol/Binary.hs
@@ -1,6 +1,3 @@
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE OverloadedStrings #-}
 --
 -- Licensed to the Apache Software Foundation (ASF) under one
 -- or more contributor license agreements. See the NOTICE file
@@ -20,145 +17,169 @@
 -- under the License.
 --
 
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
 module Thrift.Protocol.Binary
     ( module Thrift.Protocol
     , BinaryProtocol(..)
     ) where
 
 import Control.Exception ( throw )
-import Control.Monad ( liftM )
-
-import qualified Data.Binary
+import Control.Monad
 import Data.Bits
+import Data.ByteString.Lazy.Builder
+import Data.Functor
 import Data.Int
+import Data.Monoid
 import Data.Text.Lazy.Encoding ( decodeUtf8, encodeUtf8 )
 
-import GHC.Exts
-import GHC.Word
-
 import Thrift.Protocol
 import Thrift.Transport
+import Thrift.Types
 
+import qualified Data.Attoparsec.ByteString as P
+import qualified Data.Attoparsec.ByteString.Lazy as LP
+import qualified Data.Binary as Binary
 import qualified Data.ByteString.Lazy as LBS
+import qualified Data.HashMap.Strict as Map
+import qualified Data.Text.Lazy as LT
 
-version_mask :: Int32
-version_mask = 0xffff0000
+data BinaryProtocol a = BinaryProtocol a
 
-version_1 :: Int32
-version_1    = 0x80010000
-
-data BinaryProtocol a = Transport a => BinaryProtocol a
-
-
+-- NOTE: Reading and Writing functions rely on Builders and Data.Binary to
+-- encode and decode data.  Data.Binary assumes that the binary values it is
+-- encoding to and decoding from are in BIG ENDIAN format, and converts the
+-- endianness as necessary to match the local machine.
 instance Protocol BinaryProtocol where
     getTransport (BinaryProtocol t) = t
 
-    writeMessageBegin p (n, t, s) = do
-        writeI32 p (version_1 .|. (fromIntegral $ fromEnum t))
-        writeString p n
-        writeI32 p s
-    writeMessageEnd _ = return ()
+    writeMessageBegin p (n, t, s) = tWrite (getTransport p) $ toLazyByteString $
+        buildBinaryValue (TI32 (version1 .|. fromIntegral (fromEnum t))) <>
+        buildBinaryValue (TString $ encodeUtf8 n) <>
+        buildBinaryValue (TI32 s)
 
-    writeStructBegin _ _ = return ()
-    writeStructEnd _ = return ()
-    writeFieldBegin p (_, t, i) = writeType p t >> writeI16 p i
-    writeFieldEnd _ = return ()
-    writeFieldStop p = writeType p T_STOP
-    writeMapBegin p (k, v, n) = writeType p k >> writeType p v >> writeI32 p n
-    writeMapEnd _ = return ()
-    writeListBegin p (t, n) = writeType p t >> writeI32 p n
-    writeListEnd _ = return ()
-    writeSetBegin p (t, n) = writeType p t >> writeI32 p n
-    writeSetEnd _ = return ()
+    readMessageBegin p = runParser p $ do
+      TI32 ver <- parseBinaryValue T_I32
+      if ver .&. versionMask /= version1
+        then throw $ ProtocolExn PE_BAD_VERSION "Missing version identifier"
+        else do
+          TString s <- parseBinaryValue T_STRING
+          TI32 sz <- parseBinaryValue T_I32
+          return (decodeUtf8 s, toEnum $ fromIntegral $ ver .&. 0xFF, sz)
 
-    writeBool p b = tWrite (getTransport p) $ LBS.singleton $ toEnum $ if b then 1 else 0
-    writeByte p b = tWrite (getTransport p) $ Data.Binary.encode b
-    writeI16 p b = tWrite (getTransport p) $ Data.Binary.encode b
-    writeI32 p b = tWrite (getTransport p) $ Data.Binary.encode b
-    writeI64 p b = tWrite (getTransport p) $ Data.Binary.encode b
-    writeDouble p d = writeI64 p (fromIntegral $ floatBits d)
-    writeString p s = writeI32 p (fromIntegral $ LBS.length s') >> tWrite (getTransport p) s'
-      where
-        s' = encodeUtf8 s
-    writeBinary p s = writeI32 p (fromIntegral $ LBS.length s) >> tWrite (getTransport p) s
+    serializeVal _ = toLazyByteString . buildBinaryValue
+    deserializeVal _ ty bs =
+      case LP.eitherResult $ LP.parse (parseBinaryValue ty) bs of
+        Left s -> error s
+        Right val -> val
 
-    readMessageBegin p = do
-        ver <- readI32 p
-        if (ver .&. version_mask /= version_1)
-            then throw $ ProtocolExn PE_BAD_VERSION "Missing version identifier"
-            else do
-              s <- readString p
-              sz <- readI32 p
-              return (s, toEnum $ fromIntegral $ ver .&. 0xFF, sz)
-    readMessageEnd _ = return ()
-    readStructBegin _ = return ""
-    readStructEnd _ = return ()
-    readFieldBegin p = do
-        t <- readType p
-        n <- if t /= T_STOP then readI16 p else return 0
-        return ("", t, n)
-    readFieldEnd _ = return ()
-    readMapBegin p = do
-        kt <- readType p
-        vt <- readType p
-        n <- readI32 p
-        return (kt, vt, n)
-    readMapEnd _ = return ()
-    readListBegin p = do
-        t <- readType p
-        n <- readI32 p
-        return (t, n)
-    readListEnd _ = return ()
-    readSetBegin p = do
-        t <- readType p
-        n <- readI32 p
-        return (t, n)
-    readSetEnd _ = return ()
+    readVal p = runParser p . parseBinaryValue
 
-    readBool p = (== 1) `fmap` readByte p
+-- | Writing Functions
+buildBinaryValue :: ThriftVal -> Builder
+buildBinaryValue (TStruct fields) = buildBinaryStruct fields <> buildType T_STOP
+buildBinaryValue (TMap ky vt entries) =
+  buildType ky <>
+  buildType vt <>
+  int32BE (fromIntegral (length entries)) <>
+  buildBinaryMap entries
+buildBinaryValue (TList ty entries) =
+  buildType ty <>
+  int32BE (fromIntegral (length entries)) <>
+  buildBinaryList entries
+buildBinaryValue (TSet ty entries) =
+  buildType ty <>
+  int32BE (fromIntegral (length entries)) <>
+  buildBinaryList entries
+buildBinaryValue (TBool b) =
+  word8 $ toEnum $ if b then 1 else 0
+buildBinaryValue (TByte b) = int8 b
+buildBinaryValue (TI16 i) = int16BE i
+buildBinaryValue (TI32 i) = int32BE i
+buildBinaryValue (TI64 i) = int64BE i
+buildBinaryValue (TDouble d) = doubleBE d
+buildBinaryValue (TString s) = int32BE len <> lazyByteString s
+  where
+    len :: Int32 = fromIntegral (LBS.length s)
 
-    readByte p = do
-        bs <- tReadAll (getTransport p) 1
-        return $ Data.Binary.decode bs
+buildBinaryStruct :: Map.HashMap Int16 (LT.Text, ThriftVal) -> Builder
+buildBinaryStruct = Map.foldrWithKey combine mempty
+  where
+    combine fid (_,val) s =
+      buildTypeOf val <> int16BE fid <> buildBinaryValue val <> s
 
-    readI16 p = do
-        bs <- tReadAll (getTransport p) 2
-        return $ Data.Binary.decode bs
+buildBinaryMap :: [(ThriftVal, ThriftVal)] -> Builder
+buildBinaryMap = foldl combine mempty
+  where
+    combine s (key, val) = s <> buildBinaryValue key <> buildBinaryValue val
 
-    readI32 p = do
-        bs <- tReadAll (getTransport p) 4
-        return $ Data.Binary.decode bs
+buildBinaryList :: [ThriftVal] -> Builder
+buildBinaryList = foldr (mappend . buildBinaryValue) mempty
 
-    readI64 p = do
-        bs <- tReadAll (getTransport p) 8
-        return $ Data.Binary.decode bs
+-- | Reading Functions
+parseBinaryValue :: ThriftType -> P.Parser ThriftVal
+parseBinaryValue (T_STRUCT _) = TStruct <$> parseBinaryStruct
+parseBinaryValue (T_MAP _ _) = do
+  kt <- parseType
+  vt <- parseType
+  n <- Binary.decode . LBS.fromStrict <$> P.take 4
+  TMap kt vt <$> parseBinaryMap kt vt n
+parseBinaryValue (T_LIST _) = do
+  t <- parseType
+  n <- Binary.decode . LBS.fromStrict <$> P.take 4
+  TList t <$> parseBinaryList t n
+parseBinaryValue (T_SET _) = do
+  t <- parseType
+  n <- Binary.decode . LBS.fromStrict <$> P.take 4
+  TSet t <$> parseBinaryList t n
+parseBinaryValue T_BOOL = TBool . (/=0) <$> P.anyWord8
+parseBinaryValue T_BYTE = TByte . Binary.decode . LBS.fromStrict <$> P.take 1
+parseBinaryValue T_I16 = TI16 . Binary.decode . LBS.fromStrict <$> P.take 2
+parseBinaryValue T_I32 = TI32 . Binary.decode . LBS.fromStrict <$> P.take 4
+parseBinaryValue T_I64 = TI64 . Binary.decode . LBS.fromStrict <$> P.take 8
+parseBinaryValue T_DOUBLE = TDouble . bsToDouble <$> P.take 8
+parseBinaryValue T_STRING = do
+  i :: Int32  <- Binary.decode . LBS.fromStrict <$> P.take 4
+  TString . LBS.fromStrict <$> P.take (fromIntegral i)
+parseBinaryValue ty = error $ "Cannot read value of type " ++ show ty
 
-    readDouble p = do
-        bs <- readI64 p
-        return $ floatOfBits $ fromIntegral bs
+parseBinaryStruct :: P.Parser (Map.HashMap Int16 (LT.Text, ThriftVal))
+parseBinaryStruct = Map.fromList <$> P.manyTill parseField (matchType T_STOP)
+  where
+    parseField = do
+      t <- parseType
+      n <- Binary.decode . LBS.fromStrict <$> P.take 2
+      v <- parseBinaryValue t
+      return (n, ("", v))
 
-    readString p = do
-        i <- readI32 p
-        decodeUtf8 `liftM` tReadAll (getTransport p) (fromIntegral i)
+parseBinaryMap :: ThriftType -> ThriftType -> Int32 -> P.Parser [(ThriftVal, ThriftVal)]
+parseBinaryMap kt vt n | n <= 0 = return []
+                       | otherwise = do
+  k <- parseBinaryValue kt
+  v <- parseBinaryValue vt
+  ((k,v) :) <$> parseBinaryMap kt vt (n-1)
 
-    readBinary p = do
-        i <- readI32 p
-        tReadAll (getTransport p) (fromIntegral i)
+parseBinaryList :: ThriftType -> Int32 -> P.Parser [ThriftVal]
+parseBinaryList ty n | n <= 0 = return []
+                     | otherwise = liftM2 (:) (parseBinaryValue ty)
+                                   (parseBinaryList ty (n-1))
+
 
 
 -- | Write a type as a byte
-writeType :: (Protocol p, Transport t) => p t -> ThriftType -> IO ()
-writeType p t = writeByte p (fromIntegral $ fromEnum t)
+buildType :: ThriftType -> Builder
+buildType t = word8 $ fromIntegral $ fromEnum t
+
+-- | Write type of a ThriftVal as a byte
+buildTypeOf :: ThriftVal -> Builder
+buildTypeOf = buildType . getTypeOf
 
 -- | Read a byte as though it were a ThriftType
-readType :: (Protocol p, Transport t) => p t -> IO ThriftType
-readType p = do
-    b <- readByte p
-    return $ toEnum $ fromIntegral b
+parseType :: P.Parser ThriftType
+parseType = toEnum . fromIntegral <$> P.anyWord8
 
-floatBits :: Double -> Word64
-floatBits (D# d#) = W64# (unsafeCoerce# d#)
-
-floatOfBits :: Word64 -> Double
-floatOfBits (W64# b#) = D# (unsafeCoerce# b#)
-
+matchType :: ThriftType -> P.Parser ThriftType
+matchType t = t <$ P.word8 (fromIntegral $ fromEnum t)
diff --git a/lib/hs/src/Thrift/Protocol/Compact.hs b/lib/hs/src/Thrift/Protocol/Compact.hs
new file mode 100644
index 0000000..c3bd22d
--- /dev/null
+++ b/lib/hs/src/Thrift/Protocol/Compact.hs
@@ -0,0 +1,292 @@
+--
+-- Licensed to the Apache Software Foundation (ASF) under one
+-- or more contributor license agreements. See the NOTICE file
+-- distributed with this work for additional information
+-- regarding copyright ownership. The ASF licenses this file
+-- to you under the Apache License, Version 2.0 (the
+-- "License"); you may not use this file except in compliance
+-- with the License. You may obtain a copy of the License at
+--
+--   http://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing,
+-- software distributed under the License is distributed on an
+-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+-- KIND, either express or implied. See the License for the
+-- specific language governing permissions and limitations
+-- under the License.
+--
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Thrift.Protocol.Compact
+    ( module Thrift.Protocol
+    , CompactProtocol(..)
+    ) where
+
+import Control.Applicative
+import Control.Exception ( throw )
+import Control.Monad
+import Data.Attoparsec.ByteString as P
+import Data.Attoparsec.ByteString.Lazy as LP
+import Data.Bits
+import Data.ByteString.Lazy.Builder as B
+import Data.Int
+import Data.List as List
+import Data.Monoid
+import Data.Word
+import Data.Text.Lazy.Encoding ( decodeUtf8, encodeUtf8 )
+
+import Thrift.Protocol hiding (versionMask)
+import Thrift.Transport
+import Thrift.Types
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.HashMap.Strict as Map
+import qualified Data.Text.Lazy as LT
+
+-- | the Compact Protocol implements the standard Thrift 'TCompactProcotol'
+-- which is similar to the 'TBinaryProtocol', but takes less space on the wire.
+-- Integral types are encoded using as varints.
+data CompactProtocol a = CompactProtocol a
+                         -- ^ Constuct a 'CompactProtocol' with a 'Transport'
+
+protocolID, version, typeMask :: Int8
+protocolID  = 0x82 -- 1000 0010
+version     = 0x01
+versionMask = 0x1f -- 0001 1111
+typeMask    = 0xe0 -- 1110 0000
+typeShiftAmount :: Int
+typeShiftAmount = 5
+
+
+instance Protocol CompactProtocol where
+    getTransport (CompactProtocol t) = t
+
+    writeMessageBegin p (n, t, s) = tWrite (getTransport p) $ toLazyByteString $
+      B.int8 protocolID <>
+      B.int8 ((version .&. versionMask) .|.
+              (((fromIntegral $ fromEnum t) `shiftL`
+                typeShiftAmount) .&. typeMask)) <>
+      buildVarint (i32ToZigZag s) <>
+      buildCompactValue (TString $ encodeUtf8 n)
+    
+    readMessageBegin p = runParser p $ do
+      pid <- fromIntegral <$> P.anyWord8
+      when (pid /= protocolID) $ error "Bad Protocol ID"
+      w <- fromIntegral <$> P.anyWord8
+      let ver = w .&. versionMask 
+      when (ver /= version) $ error "Bad Protocol version"
+      let typ = (w `shiftR` typeShiftAmount) .&. 0x03
+      seqId <- parseVarint zigZagToI32
+      TString name <- parseCompactValue T_STRING
+      return (decodeUtf8 name, toEnum $ fromIntegral $ typ, seqId)
+
+    serializeVal _ = toLazyByteString . buildCompactValue
+    deserializeVal _ ty bs =
+      case LP.eitherResult $ LP.parse (parseCompactValue ty) bs of
+        Left s -> error s
+        Right val -> val
+
+    readVal p ty = runParser p $ parseCompactValue ty
+
+
+-- | Writing Functions
+buildCompactValue :: ThriftVal -> Builder
+buildCompactValue (TStruct fields) = buildCompactStruct fields
+buildCompactValue (TMap kt vt entries) =
+  let len = fromIntegral $ length entries :: Word32 in
+  if len == 0
+  then B.word8 0x00
+  else buildVarint len <>
+       B.word8 (fromTType kt `shiftL` 4 .|. fromTType vt) <>
+       buildCompactMap entries
+buildCompactValue (TList ty entries) =
+  let len = length entries in
+  (if len < 15
+   then B.word8 $ (fromIntegral len `shiftL` 4) .|. fromTType ty
+   else B.word8 (0xF0 .|. fromTType ty) <>
+        buildVarint (fromIntegral len :: Word32)) <>
+  buildCompactList entries
+buildCompactValue (TSet ty entries) = buildCompactValue (TList ty entries)
+buildCompactValue (TBool b) =
+  B.word8 $ toEnum $ if b then 1 else 0
+buildCompactValue (TByte b) = int8 b
+buildCompactValue (TI16 i) = buildVarint $ i16ToZigZag i
+buildCompactValue (TI32 i) = buildVarint $ i32ToZigZag i
+buildCompactValue (TI64 i) = buildVarint $ i64ToZigZag i
+buildCompactValue (TDouble d) = doubleBE d
+buildCompactValue (TString s) = buildVarint len <> lazyByteString s
+  where
+    len = fromIntegral (LBS.length s) :: Word32
+
+buildCompactStruct :: Map.HashMap Int16 (LT.Text, ThriftVal) -> Builder
+buildCompactStruct = flip (loop 0) mempty . Map.toList
+  where
+    loop _ [] acc = acc <> B.word8 (fromTType T_STOP)
+    loop lastId ((fid, (_,val)) : fields) acc = loop fid fields $ acc <>
+      (if fid > lastId && fid - lastId <= 15
+       then B.word8 $ fromIntegral ((fid - lastId) `shiftL` 4) .|. typeOf val
+       else B.word8 (typeOf val) <> buildVarint (i16ToZigZag fid)) <>
+      (if typeOf val > 0x02 -- Not a T_BOOL
+       then buildCompactValue val
+       else mempty) -- T_BOOLs are encoded in the type
+buildCompactMap :: [(ThriftVal, ThriftVal)] -> Builder
+buildCompactMap = foldl combine mempty
+  where
+    combine s (key, val) = buildCompactValue key <> buildCompactValue val <> s
+
+buildCompactList :: [ThriftVal] -> Builder
+buildCompactList = foldr (mappend . buildCompactValue) mempty
+
+-- | Reading Functions
+parseCompactValue :: ThriftType -> Parser ThriftVal
+parseCompactValue (T_STRUCT _) = TStruct <$> parseCompactStruct
+parseCompactValue (T_MAP kt' vt') = do
+  n <- parseVarint id
+  if n == 0
+    then return $ TMap kt' vt' []
+    else do
+    w <- P.anyWord8
+    let kt = typeFrom $ w `shiftR` 4
+        vt = typeFrom $ w .&. 0x0F
+    TMap kt vt <$> parseCompactMap kt vt n
+parseCompactValue (T_LIST ty) = TList ty <$> parseCompactList
+parseCompactValue (T_SET ty) = TSet ty <$> parseCompactList
+parseCompactValue T_BOOL = TBool . (/=0) <$> P.anyWord8
+parseCompactValue T_BYTE = TByte . fromIntegral <$> P.anyWord8
+parseCompactValue T_I16 = TI16 <$> parseVarint zigZagToI16
+parseCompactValue T_I32 = TI32 <$> parseVarint zigZagToI32
+parseCompactValue T_I64 = TI64 <$> parseVarint zigZagToI64
+parseCompactValue T_DOUBLE = TDouble . bsToDouble <$> P.take 8
+parseCompactValue T_STRING = do
+  len :: Word32 <- parseVarint id
+  TString . LBS.fromStrict <$> P.take (fromIntegral len)
+parseCompactValue ty = error $ "Cannot read value of type " ++ show ty
+
+parseCompactStruct :: Parser (Map.HashMap Int16 (LT.Text, ThriftVal))
+parseCompactStruct = Map.fromList <$> parseFields 0
+  where
+    parseFields :: Int16 -> Parser [(Int16, (LT.Text, ThriftVal))]
+    parseFields lastId = do
+      w <- P.anyWord8
+      if w == 0x00
+        then return []
+        else do
+          let ty = typeFrom (w .&. 0x0F)
+              modifier = (w .&. 0xF0) `shiftR` 4
+          fid <- if modifier /= 0
+                 then return (lastId + fromIntegral modifier)
+                 else parseVarint zigZagToI16
+          val <- if ty == T_BOOL
+                 then return (TBool $ (w .&. 0x0F) == 0x01)
+                 else parseCompactValue ty
+          ((fid, (LT.empty, val)) : ) <$> parseFields fid
+
+parseCompactMap :: ThriftType -> ThriftType -> Int32 ->
+                   Parser [(ThriftVal, ThriftVal)]
+parseCompactMap kt vt n | n <= 0 = return []
+                        | otherwise = do
+  k <- parseCompactValue kt
+  v <- parseCompactValue vt
+  ((k,v) :) <$> parseCompactMap kt vt (n-1)
+
+parseCompactList :: Parser [ThriftVal]
+parseCompactList = do
+  w <- P.anyWord8
+  let ty = typeFrom $ w .&. 0x0F
+      lsize = w `shiftR` 4
+  size <- if lsize == 0xF
+          then parseVarint id
+          else return $ fromIntegral lsize
+  loop ty size
+  where
+    loop :: ThriftType -> Int32 -> Parser [ThriftVal]
+    loop ty n | n <= 0 = return []
+              | otherwise = liftM2 (:) (parseCompactValue ty)
+                            (loop ty (n-1))
+
+-- Signed numbers must be converted to "Zig Zag" format before they can be
+-- serialized in the Varint format
+i16ToZigZag :: Int16 -> Word16
+i16ToZigZag n = fromIntegral $ (n `shiftL` 1) `xor` (n `shiftR` 15)
+
+zigZagToI16 :: Word16 -> Int16
+zigZagToI16 n = fromIntegral $ (n `shiftR` 1) `xor` negate (n .&. 0x1)
+
+i32ToZigZag :: Int32 -> Word32
+i32ToZigZag n = fromIntegral $ (n `shiftL` 1) `xor` (n `shiftR` 31)
+
+zigZagToI32 :: Word32 -> Int32
+zigZagToI32 n = fromIntegral $ (n `shiftR` 1) `xor` negate (n .&. 0x1)
+
+i64ToZigZag :: Int64 -> Word64
+i64ToZigZag n = fromIntegral $ (n `shiftL` 1) `xor` (n `shiftR` 63)
+
+zigZagToI64 :: Word64 -> Int64
+zigZagToI64 n = fromIntegral $ (n `shiftR` 1) `xor` negate (n .&. 0x1)
+
+buildVarint :: (Bits a, Integral a)  => a -> Builder
+buildVarint n | n .&. complement 0x7F == 0 = B.word8 $ fromIntegral n
+              | otherwise = B.word8 (0x80 .|. (fromIntegral n .&. 0x7F)) <>
+                            buildVarint (n `shiftR` 7)
+
+parseVarint :: (Bits a, Integral a, Ord a) => (a -> b) -> Parser b
+parseVarint fromZigZag = do
+  bytestemp <- BS.unpack <$> P.takeTill (not . flip testBit 7)
+  lsb <- P.anyWord8
+  let bytes = lsb : List.reverse bytestemp
+  return $ fromZigZag $ List.foldl' combine 0x00 bytes
+  where combine a b = (a `shiftL` 7) .|. (fromIntegral b .&. 0x7f)
+
+-- | Compute the Compact Type
+fromTType :: ThriftType -> Word8
+fromTType ty = case ty of
+  T_STOP -> 0x00
+  T_BOOL -> 0x01
+  T_BYTE -> 0x03
+  T_I16 -> 0x04
+  T_I32 -> 0x05
+  T_I64 -> 0x06
+  T_DOUBLE -> 0x07
+  T_STRING -> 0x08
+  T_LIST{} -> 0x09
+  T_SET{} -> 0x0A
+  T_MAP{} -> 0x0B
+  T_STRUCT{} -> 0x0C
+  T_VOID -> error "No Compact type for T_VOID"
+
+typeOf :: ThriftVal -> Word8
+typeOf v = case v of
+  TBool True -> 0x01
+  TBool False -> 0x02
+  TByte _ -> 0x03
+  TI16 _ -> 0x04
+  TI32 _ -> 0x05
+  TI64 _ -> 0x06
+  TDouble _ -> 0x07
+  TString _ -> 0x08
+  TList{} -> 0x09
+  TSet{} -> 0x0A
+  TMap{} -> 0x0B
+  TStruct{} -> 0x0C
+  
+typeFrom :: Word8 -> ThriftType
+typeFrom w = case w of
+  0x01 -> T_BOOL
+  0x02 -> T_BOOL
+  0x03 -> T_BYTE
+  0x04 -> T_I16
+  0x05 -> T_I32
+  0x06 -> T_I64
+  0x07 -> T_DOUBLE
+  0x08 -> T_STRING
+  0x09 -> T_LIST T_VOID
+  0x0A -> T_SET T_VOID
+  0x0B -> T_MAP T_VOID T_VOID
+  0x0C -> T_STRUCT Map.empty
+  n -> error $ "typeFrom: " ++ show n ++ " is not a compact type"
diff --git a/lib/hs/src/Thrift/Protocol/JSON.hs b/lib/hs/src/Thrift/Protocol/JSON.hs
new file mode 100644
index 0000000..f378ea2
--- /dev/null
+++ b/lib/hs/src/Thrift/Protocol/JSON.hs
@@ -0,0 +1,325 @@
+--
+-- Licensed to the Apache Software Foundation (ASF) under one
+-- or more contributor license agreements. See the NOTICE file
+-- distributed with this work for additional information
+-- regarding copyright ownership. The ASF licenses this file
+-- to you under the Apache License, Version 2.0 (the
+-- "License"); you may not use this file except in compliance
+-- with the License. You may obtain a copy of the License at
+--
+--   http://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing,
+-- software distributed under the License is distributed on an
+-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+-- KIND, either express or implied. See the License for the
+-- specific language governing permissions and limitations
+-- under the License.
+--
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+
+module Thrift.Protocol.JSON
+    ( module Thrift.Protocol
+    , JSONProtocol(..)
+    ) where
+
+import Control.Applicative
+import Control.Monad
+import Data.Attoparsec.ByteString as P
+import Data.Attoparsec.ByteString.Char8 as PC
+import Data.Attoparsec.ByteString.Lazy as LP
+import Data.ByteString.Lazy.Builder as B
+import Data.ByteString.Internal (c2w, w2c)
+import Data.Functor
+import Data.Int
+import Data.List
+import Data.Maybe (catMaybes)
+import Data.Monoid
+import Data.Text.Lazy.Encoding
+import Data.Word
+import qualified Data.HashMap.Strict as Map
+
+import Thrift.Protocol
+import Thrift.Transport
+import Thrift.Types
+
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Text.Lazy as LT
+
+-- | The JSON Protocol data uses the standard 'TSimpleJSONProtocol'.  Data is
+-- encoded as a JSON 'ByteString'
+data JSONProtocol t = JSONProtocol t
+                      -- ^ Construct a 'JSONProtocol' with a 'Transport'
+
+instance Protocol JSONProtocol where
+    getTransport (JSONProtocol t) = t
+
+    writeMessageBegin (JSONProtocol t) (s, ty, sq) = tWrite t $ toLazyByteString $
+      B.char8 '[' <> buildShowable (1 :: Int32) <>
+      B.string8 ",\"" <> escape (encodeUtf8 s) <> B.char8 '\"' <>
+      B.char8 ',' <> buildShowable (fromEnum ty) <>
+      B.char8 ',' <> buildShowable sq <>
+      B.char8 ','
+    writeMessageEnd (JSONProtocol t) = tWrite t "]"
+    readMessageBegin p = runParser p $ skipSpace *> do
+      _ver :: Int32 <- lexeme (PC.char8 '[') *> lexeme (signed decimal)
+      bs <- lexeme (PC.char8 ',') *> lexeme escapedString
+      case decodeUtf8' bs of
+        Left _ -> fail "readMessage: invalid text encoding"
+        Right str -> do
+          ty <- toEnum <$> (lexeme (PC.char8 ',') *> lexeme (signed decimal))
+          seqNum <- lexeme (PC.char8 ',') *> lexeme (signed decimal)
+          _ <- PC.char8 ','
+          return (str, ty, seqNum)
+    readMessageEnd p = void $ runParser p (PC.char8 ']')
+
+    serializeVal _ = toLazyByteString . buildJSONValue
+    deserializeVal _ ty bs =
+      case LP.eitherResult $ LP.parse (parseJSONValue ty) bs of
+        Left s -> error s
+        Right val -> val
+
+    readVal p ty = runParser p $ skipSpace *> parseJSONValue ty
+
+
+-- Writing Functions
+
+buildJSONValue :: ThriftVal -> Builder
+buildJSONValue (TStruct fields) = B.char8 '{' <> buildJSONStruct fields <> B.char8 '}'
+buildJSONValue (TMap kt vt entries) =
+  B.char8 '[' <> B.char8 '"' <> getTypeName kt <> B.char8 '"' <>
+  B.char8 ',' <> B.char8 '"' <> getTypeName vt <> B.char8 '"' <>
+  B.char8 ',' <> buildShowable (length entries) <>
+  B.char8 ',' <> B.char8 '{' <> buildJSONMap entries <> B.char8 '}' <>
+  B.char8 ']'
+buildJSONValue (TList ty entries) =
+  B.char8 '[' <> B.char8 '"' <> getTypeName ty <> B.char8 '"' <>
+  B.char8 ',' <> buildShowable (length entries) <>
+  (if length entries > 0
+   then B.char8 ',' <> buildJSONList entries
+   else mempty) <>
+  B.char8 ']'
+buildJSONValue (TSet ty entries) = buildJSONValue (TList ty entries)
+buildJSONValue (TBool b) = if b then B.string8 "true" else B.string8 "false"
+buildJSONValue (TByte b) = buildShowable b
+buildJSONValue (TI16 i) = buildShowable i
+buildJSONValue (TI32 i) = buildShowable i
+buildJSONValue (TI64 i) = buildShowable i
+buildJSONValue (TDouble d) = buildShowable d
+buildJSONValue (TString s) = B.char8 '\"' <> escape s <> B.char8 '\"'
+
+buildJSONStruct :: Map.HashMap Int16 (LT.Text, ThriftVal) -> Builder
+buildJSONStruct = mconcat . intersperse (B.char8 ',') . Map.foldrWithKey buildField []
+  where 
+    buildField fid (_,val) = (:) $
+      B.char8 '"' <> buildShowable fid <> B.string8 "\":" <> 
+      B.char8 '{' <>
+      B.char8 '"' <> getTypeName (getTypeOf val) <> B.string8 "\":" <>
+      buildJSONValue val <>
+      B.char8 '}'
+
+buildJSONMap :: [(ThriftVal, ThriftVal)] -> Builder
+buildJSONMap = mconcat . intersperse (B.char8 ',') . map buildKV
+  where
+    buildKV (key@(TString _), val) =
+      buildJSONValue key <> B.char8 ':' <> buildJSONValue val
+    buildKV (key, val) =
+      B.char8 '\"' <> buildJSONValue key <> B.string8 "\":" <> buildJSONValue val
+buildJSONList :: [ThriftVal] -> Builder
+buildJSONList = mconcat . intersperse (B.char8 ',') . map buildJSONValue
+
+buildShowable :: Show a => a ->  Builder
+buildShowable = B.string8 . show
+
+-- Reading Functions
+
+parseJSONValue :: ThriftType -> Parser ThriftVal
+parseJSONValue (T_STRUCT tmap) =
+  TStruct <$> (lexeme (PC.char8 '{') *> parseJSONStruct tmap <* PC.char8 '}')
+parseJSONValue (T_MAP kt vt) = fmap (TMap kt vt) $
+  between '[' ']' $
+    lexeme escapedString *> lexeme (PC.char8 ',') *>
+    lexeme escapedString *> lexeme (PC.char8 ',') *>
+    lexeme decimal *> lexeme (PC.char8 ',') *>
+    between '{' '}' (parseJSONMap kt vt)
+parseJSONValue (T_LIST ty) = fmap (TList ty) $
+  between '[' ']' $ do
+    len <- lexeme escapedString *> lexeme (PC.char8 ',') *>
+           lexeme decimal <* lexeme (PC.char8 ',')
+    if len > 0 then parseJSONList ty else return []
+parseJSONValue (T_SET ty) = fmap (TSet ty) $
+  between '[' ']' $ do
+    len <- lexeme escapedString *> lexeme (PC.char8 ',') *>
+           lexeme decimal <* lexeme (PC.char8 ',')
+    if len > 0 then parseJSONList ty else return []
+parseJSONValue T_BOOL =
+  (TBool True <$ string "true") <|> (TBool False <$ string "false")
+parseJSONValue T_BYTE = TByte <$> signed decimal
+parseJSONValue T_I16 = TI16 <$> signed decimal
+parseJSONValue T_I32 = TI32 <$> signed decimal
+parseJSONValue T_I64 = TI64 <$> signed decimal
+parseJSONValue T_DOUBLE = TDouble <$> double
+parseJSONValue T_STRING = TString <$> escapedString
+parseJSONValue T_STOP = fail "parseJSONValue: cannot parse type T_STOP"
+parseJSONValue T_VOID = fail "parseJSONValue: cannot parse type T_VOID"
+
+parseAnyValue :: Parser ()
+parseAnyValue = choice $
+                skipBetween '{' '}' :
+                skipBetween '[' ']' :
+                map (void . parseJSONValue)
+                  [ T_BOOL
+                  , T_I16
+                  , T_I32
+                  , T_I64
+                  , T_DOUBLE
+                  , T_STRING
+                  ]
+  where
+    skipBetween :: Char -> Char -> Parser ()
+    skipBetween a b = between a b $ void (PC.satisfy (\c -> c /= a && c /= b))
+                                          <|> skipBetween a b
+
+parseJSONStruct :: TypeMap -> Parser (Map.HashMap Int16 (LT.Text, ThriftVal))
+parseJSONStruct tmap = Map.fromList . catMaybes <$> parseField
+                       `sepBy` lexeme (PC.char8 ',')
+  where
+    parseField = do
+      fid <- lexeme (between '"' '"' decimal) <* lexeme (PC.char8 ':')
+      case Map.lookup fid tmap of
+        Just (str, ftype) -> between '{' '}' $ do
+          _ <- lexeme (escapedString) *> lexeme (PC.char8 ':')
+          val <- lexeme (parseJSONValue ftype)
+          return $ Just (fid, (str, val))
+        Nothing -> lexeme parseAnyValue *> return Nothing
+
+parseJSONMap :: ThriftType -> ThriftType -> Parser [(ThriftVal, ThriftVal)]
+parseJSONMap kt vt =
+  ((,) <$> lexeme (PC.char8 '"' *> parseJSONValue kt <* PC.char8 '"') <*>
+   (lexeme (PC.char8 ':') *> lexeme (parseJSONValue vt))) `sepBy`
+  lexeme (PC.char8 ',')
+
+parseJSONList :: ThriftType -> Parser [ThriftVal]
+parseJSONList ty = lexeme (parseJSONValue ty) `sepBy` lexeme (PC.char8 ',')
+
+escapedString :: Parser LBS.ByteString
+escapedString = PC.char8 '"' *>
+                (LBS.pack <$> P.many' (escapedChar <|> notChar8 '"')) <*
+                PC.char8 '"'
+
+escapedChar :: Parser Word8
+escapedChar = PC.char8 '\\' *> (c2w <$> choice
+                                [ '\SOH' <$ P.string "u0001"
+                                , '\STX' <$ P.string "u0002"
+                                , '\ETX' <$ P.string "u0003"
+                                , '\EOT' <$ P.string "u0004"
+                                , '\ENQ' <$ P.string "u0005"
+                                , '\ACK' <$ P.string "u0006"
+                                , '\BEL' <$ P.string "u0007"
+                                , '\BS'  <$ P.string "u0008"
+                                , '\VT'  <$ P.string "u000b"
+                                , '\FF'  <$ P.string "u000c"
+                                , '\CR'  <$ P.string "u000d"
+                                , '\SO'  <$ P.string "u000e"
+                                , '\SI'  <$ P.string "u000f"
+                                , '\DLE' <$ P.string "u0010"
+                                , '\DC1' <$ P.string "u0011"
+                                , '\DC2' <$ P.string "u0012"
+                                , '\DC3' <$ P.string "u0013"
+                                , '\DC4' <$ P.string "u0014"
+                                , '\NAK' <$ P.string "u0015"
+                                , '\SYN' <$ P.string "u0016"
+                                , '\ETB' <$ P.string "u0017"
+                                , '\CAN' <$ P.string "u0018"
+                                , '\EM'  <$ P.string "u0019"
+                                , '\SUB' <$ P.string "u001a"
+                                , '\ESC' <$ P.string "u001b"
+                                , '\FS'  <$ P.string "u001c"
+                                , '\GS'  <$ P.string "u001d"
+                                , '\RS'  <$ P.string "u001e"
+                                , '\US'  <$ P.string "u001f"
+                                , '\DEL' <$ P.string "u007f"
+                                , '\0' <$ PC.char '0'
+                                , '\a' <$ PC.char 'a'
+                                , '\b' <$ PC.char 'b'
+                                , '\f' <$ PC.char 'f'
+                                , '\n' <$ PC.char 'n'
+                                , '\r' <$ PC.char 'r'
+                                , '\t' <$ PC.char 't'
+                                , '\v' <$ PC.char 'v'
+                                , '\"' <$ PC.char '"'
+                                , '\'' <$ PC.char '\''
+                                , '\\' <$ PC.char '\\'
+                                , '/'  <$ PC.char '/'
+                                ])
+
+escape :: LBS.ByteString -> Builder
+escape = LBS.foldl' escapeChar mempty
+  where
+    escapeChar b w = b <> (B.lazyByteString $ case w2c w of
+      '\0' -> "\\0"
+      '\b' -> "\\b"
+      '\f' -> "\\f"
+      '\n' -> "\\n"
+      '\r' -> "\\r"
+      '\t' -> "\\t"
+      '\"' -> "\\\""
+      '\\' -> "\\\\"
+      '\SOH' -> "\\u0001"
+      '\STX' -> "\\u0002"
+      '\ETX' -> "\\u0003"
+      '\EOT' -> "\\u0004"
+      '\ENQ' -> "\\u0005"
+      '\ACK' -> "\\u0006"
+      '\BEL' -> "\\u0007"
+      '\VT'  -> "\\u000b"
+      '\SO'  -> "\\u000e"
+      '\SI'  -> "\\u000f"
+      '\DLE' -> "\\u0010"
+      '\DC1' -> "\\u0011"
+      '\DC2' -> "\\u0012"
+      '\DC3' -> "\\u0013"
+      '\DC4' -> "\\u0014"
+      '\NAK' -> "\\u0015"
+      '\SYN' -> "\\u0016"
+      '\ETB' -> "\\u0017"
+      '\CAN' -> "\\u0018"
+      '\EM'  -> "\\u0019"
+      '\SUB' -> "\\u001a"
+      '\ESC' -> "\\u001b"
+      '\FS'  -> "\\u001c"
+      '\GS'  -> "\\u001d"
+      '\RS'  -> "\\u001e"
+      '\US'  -> "\\u001f"
+      '\DEL' -> "\\u007f"
+      _ -> LBS.singleton w)
+
+lexeme :: Parser a -> Parser a
+lexeme = (<* skipSpace)
+
+notChar8 :: Char -> Parser Word8
+notChar8 c = P.satisfy (/= c2w c)
+
+between :: Char -> Char -> Parser a -> Parser a
+between a b p = lexeme (PC.char8 a) *> lexeme p <* lexeme (PC.char8 b)
+
+getTypeName :: ThriftType -> Builder
+getTypeName ty = B.string8 $ case ty of
+  T_STRUCT _ -> "rec"
+  T_MAP _ _  -> "map"
+  T_LIST _   -> "lst"
+  T_SET _    -> "set"
+  T_BOOL     -> "tf"
+  T_BYTE     -> "i8"
+  T_I16      -> "i16"
+  T_I32      -> "i32"
+  T_I64      -> "i64"
+  T_DOUBLE   -> "dbl"
+  T_STRING   -> "str"
+  _ -> error "Unrecognized Type"
+
diff --git a/lib/hs/src/Thrift/Transport.hs b/lib/hs/src/Thrift/Transport.hs
index 3e5f18b..306edc2 100644
--- a/lib/hs/src/Thrift/Transport.hs
+++ b/lib/hs/src/Thrift/Transport.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 --
 -- Licensed to the Apache Software Foundation (ASF) under one
 -- or more contributor license agreements. See the NOTICE file
@@ -26,8 +27,9 @@
 
 import Control.Monad ( when )
 import Control.Exception ( Exception, throw )
-
+import Data.Functor ( (<$>) )
 import Data.Typeable ( Typeable )
+import Data.Word
 
 import qualified Data.ByteString.Lazy as LBS
 import Data.Monoid
@@ -36,6 +38,7 @@
     tIsOpen :: a -> IO Bool
     tClose  :: a -> IO ()
     tRead   :: a -> Int -> IO LBS.ByteString
+    tPeek   :: a -> IO (Maybe Word8)
     tWrite  :: a -> LBS.ByteString -> IO ()
     tFlush  :: a -> IO ()
     tReadAll :: a -> Int -> IO LBS.ByteString
@@ -46,8 +49,8 @@
         let rlen = fromIntegral $ LBS.length result
         when (rlen == 0) (throw $ TransportExn "Cannot read. Remote side has closed." TE_UNKNOWN)
         if len <= rlen
-            then return result
-            else (result `mappend`) `fmap` (tReadAll a (len - rlen))
+          then return result
+          else (result `mappend`) <$> tReadAll a (len - rlen)
 
 data TransportExn = TransportExn String TransportExnType
   deriving ( Show, Typeable )
@@ -60,4 +63,3 @@
     | TE_TIMED_OUT
     | TE_END_OF_FILE
       deriving ( Eq, Show, Typeable )
-
diff --git a/lib/hs/src/Thrift/Transport/Empty.hs b/lib/hs/src/Thrift/Transport/Empty.hs
new file mode 100644
index 0000000..47af5fe
--- /dev/null
+++ b/lib/hs/src/Thrift/Transport/Empty.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+--
+-- Licensed to the Apache Software Foundation (ASF) under one
+-- or more contributor license agreements. See the NOTICE file
+-- distributed with this work for additional information
+-- regarding copyright ownership. The ASF licenses this file
+-- to you under the Apache License, Version 2.0 (the
+-- "License"); you may not use this file except in compliance
+-- with the License. You may obtain a copy of the License at
+--
+--   http://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing,
+-- software distributed under the License is distributed on an
+-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+-- KIND, either express or implied. See the License for the
+-- specific language governing permissions and limitations
+-- under the License.
+--
+
+module Thrift.Transport.Empty
+       ( EmptyTransport(..)
+       ) where
+
+import Thrift.Transport
+
+data EmptyTransport = EmptyTransport
+
+instance Transport EmptyTransport where
+    tIsOpen = const $ return False
+    tClose  = const $ return ()
+    tRead _ _ = return ""
+    tPeek = const $ return Nothing
+    tWrite _ _ = return ()
+    tFlush = const$ return ()
diff --git a/lib/hs/src/Thrift/Transport/Framed.hs b/lib/hs/src/Thrift/Transport/Framed.hs
index d4feac0..42fc43f 100644
--- a/lib/hs/src/Thrift/Transport/Framed.hs
+++ b/lib/hs/src/Thrift/Transport/Framed.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 --
 -- Licensed to the Apache Software Foundation (ASF) under one
 -- or more contributor license agreements. See the NOTICE file
@@ -25,13 +26,10 @@
     ) where
 
 import Thrift.Transport
+import Thrift.Transport.IOBuffer
 
-import Control.Monad (liftM)
 import Data.Int (Int32)
-import Data.Monoid (mappend, mempty)
-import Control.Concurrent.MVar
 import qualified Data.Binary as B
-import qualified Data.Binary.Builder as BB
 import qualified Data.ByteString.Lazy as LBS
 
 
@@ -65,8 +63,17 @@
                  then tRead trans n
                  else return bs
          else return bs
+    tPeek trans = do
+      mw <- peekBuf (readBuffer trans)
+      case mw of
+        Just _ -> return mw
+        Nothing -> do
+          len <- readFrame trans
+          if len > 0
+             then tPeek trans
+             else return Nothing
 
-    tWrite trans = writeBuf (writeBuffer trans)
+    tWrite = writeBuf . writeBuffer
 
     tFlush trans = do
       bs <- flushBuf (writeBuffer trans)
@@ -84,37 +91,9 @@
   let sz = fromIntegral (B.decode szBs :: Int32)
 
   -- Read the frame and stuff it into the read buffer.
-  bs   <- tRead (wrappedTrans trans) sz
+  bs <- tRead (wrappedTrans trans) sz
   fillBuf (readBuffer trans) bs
 
   -- Return the frame size so that the caller knows whether to expect
   -- something in the read buffer or not.
   return sz
-
-
--- Mini IO buffers (stolen from HttpClient.hs)
-
-type WriteBuffer = MVar (BB.Builder)
-
-newWriteBuffer :: IO WriteBuffer
-newWriteBuffer = newMVar mempty
-
-writeBuf :: WriteBuffer -> LBS.ByteString -> IO ()
-writeBuf w s = modifyMVar_ w $ return . (\builder ->
-                 builder `mappend` (BB.fromLazyByteString s))
-
-flushBuf :: WriteBuffer -> IO (LBS.ByteString)
-flushBuf w = BB.toLazyByteString `liftM` swapMVar w mempty
-
-
-type ReadBuffer = MVar (LBS.ByteString)
-
-newReadBuffer :: IO ReadBuffer
-newReadBuffer = newMVar mempty
-
-fillBuf :: ReadBuffer -> LBS.ByteString -> IO ()
-fillBuf r s = swapMVar r s >> return ()
-
-readBuf :: ReadBuffer -> Int -> IO (LBS.ByteString)
-readBuf r n = modifyMVar r $ return . flipPair . LBS.splitAt (fromIntegral n)
-    where flipPair (a, b) = (b, a)
diff --git a/lib/hs/src/Thrift/Transport/Handle.hs b/lib/hs/src/Thrift/Transport/Handle.hs
index cf4822b..d6cfe31 100644
--- a/lib/hs/src/Thrift/Transport/Handle.hs
+++ b/lib/hs/src/Thrift/Transport/Handle.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -27,10 +27,9 @@
     , HandleSource(..)
     ) where
 
-import Prelude hiding ( catch )
-
 import Control.Exception ( catch, throw )
-import Control.Monad ()
+import Data.ByteString.Internal (c2w)
+import Data.Functor
 
 import Network
 
@@ -44,9 +43,10 @@
 
 instance Transport Handle where
     tIsOpen = hIsOpen
-    tClose h    = hClose h
-    tRead  h n  = LBS.hGet h n `catch` handleEOF
-    tWrite h s  = LBS.hPut h s
+    tClose = hClose
+    tRead h n = LBS.hGet h n `catch` handleEOF mempty
+    tPeek h = (Just . c2w <$> hLookAhead h) `catch` handleEOF Nothing
+    tWrite = LBS.hPut
     tFlush = hFlush
 
 
@@ -62,7 +62,7 @@
     hOpen = uncurry connectTo
 
 
-handleEOF :: forall a (m :: * -> *).(Monoid a, Monad m) => IOError -> m a
-handleEOF e = if isEOFError e
-    then return mempty
+handleEOF :: a -> IOError -> IO a
+handleEOF a e = if isEOFError e
+    then return a
     else throw $ TransportExn "TChannelTransport: Could not read" TE_UNKNOWN
diff --git a/lib/hs/src/Thrift/Transport/HttpClient.hs b/lib/hs/src/Thrift/Transport/HttpClient.hs
index b1b0982..edeb320 100644
--- a/lib/hs/src/Thrift/Transport/HttpClient.hs
+++ b/lib/hs/src/Thrift/Transport/HttpClient.hs
@@ -22,18 +22,16 @@
     ( module Thrift.Transport
     , HttpClient (..)
     , openHttpClient
-    ) where
+) where
 
 import Thrift.Transport
+import Thrift.Transport.IOBuffer
 import Network.URI
 import Network.HTTP hiding (port, host)
 
-import Control.Monad (liftM)
 import Data.Maybe (fromJust)
-import Data.Monoid (mappend, mempty)
+import Data.Monoid (mempty)
 import Control.Exception (throw)
-import Control.Concurrent.MVar
-import qualified Data.Binary.Builder as B
 import qualified Data.ByteString.Lazy as LBS
 
 
@@ -73,11 +71,13 @@
 
 instance Transport HttpClient where
 
-    tClose  = close . hstream
+    tClose = close . hstream
 
-    tRead hclient n = readBuf (readBuffer hclient) n
+    tPeek = peekBuf . readBuffer
 
-    tWrite hclient = writeBuf (writeBuffer hclient)
+    tRead = readBuf . readBuffer
+
+    tWrite = writeBuf . writeBuffer
 
     tFlush hclient = do
       body <- flushBuf $ writeBuffer hclient
@@ -92,36 +92,10 @@
 
       res <- sendHTTP (hstream hclient) request
       case res of
-        Right response -> do
-            fillBuf (readBuffer hclient) (rspBody response)
-        Left _ -> do
+        Right response ->
+          fillBuf (readBuffer hclient) (rspBody response)
+        Left _ ->
             throw $ TransportExn "THttpConnection: HTTP failure from server" TE_UNKNOWN
       return ()
 
     tIsOpen _ = return True
--- Mini IO buffers
-
-type WriteBuffer = MVar (B.Builder)
-
-newWriteBuffer :: IO WriteBuffer
-newWriteBuffer = newMVar mempty
-
-writeBuf :: WriteBuffer -> LBS.ByteString -> IO ()
-writeBuf w s = modifyMVar_ w $ return . (\builder ->
-                 builder `mappend` (B.fromLazyByteString s))
-
-flushBuf :: WriteBuffer -> IO (LBS.ByteString)
-flushBuf w = B.toLazyByteString `liftM` swapMVar w mempty
-
-
-type ReadBuffer = MVar (LBS.ByteString)
-
-newReadBuffer :: IO ReadBuffer
-newReadBuffer = newMVar mempty
-
-fillBuf :: ReadBuffer -> LBS.ByteString -> IO ()
-fillBuf r s = swapMVar r s >> return ()
-
-readBuf :: ReadBuffer -> Int -> IO (LBS.ByteString)
-readBuf r n = modifyMVar r $ return . flipPair . LBS.splitAt (fromIntegral n)
-    where flipPair (a, b) = (b, a)
diff --git a/lib/hs/src/Thrift/Transport/IOBuffer.hs b/lib/hs/src/Thrift/Transport/IOBuffer.hs
new file mode 100644
index 0000000..7ebd7d8
--- /dev/null
+++ b/lib/hs/src/Thrift/Transport/IOBuffer.hs
@@ -0,0 +1,69 @@
+--
+-- Licensed to the Apache Software Foundation (ASF) under one
+-- or more contributor license agreements. See the NOTICE file
+-- distributed with this work for additional information
+-- regarding copyright ownership. The ASF licenses this file
+-- to you under the Apache License, Version 2.0 (the
+-- "License"); you may not use this file except in compliance
+-- with the License. You may obtain a copy of the License at
+--
+--   http://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing,
+-- software distributed under the License is distributed on an
+-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+-- KIND, either express or implied. See the License for the
+-- specific language governing permissions and limitations
+-- under the License.
+--
+
+module Thrift.Transport.IOBuffer
+       ( WriteBuffer
+       , newWriteBuffer
+       , writeBuf
+       , flushBuf
+       , ReadBuffer
+       , newReadBuffer
+       , fillBuf
+       , readBuf
+       , peekBuf
+       ) where
+
+import Data.ByteString.Lazy.Builder
+import Data.Functor
+import Data.IORef
+import Data.Monoid
+import Data.Word
+
+import qualified Data.ByteString.Lazy as LBS
+
+type WriteBuffer = IORef Builder
+type ReadBuffer = IORef LBS.ByteString
+
+newWriteBuffer :: IO WriteBuffer
+newWriteBuffer = newIORef mempty
+
+writeBuf :: WriteBuffer -> LBS.ByteString -> IO ()
+writeBuf w s = modifyIORef w ( <> lazyByteString s)
+
+flushBuf :: WriteBuffer -> IO LBS.ByteString
+flushBuf w = do
+  buf <- readIORef w
+  writeIORef w mempty
+  return $ toLazyByteString buf
+
+newReadBuffer :: IO ReadBuffer
+newReadBuffer = newIORef mempty
+
+fillBuf :: ReadBuffer -> LBS.ByteString -> IO ()
+fillBuf = writeIORef
+
+readBuf :: ReadBuffer -> Int -> IO LBS.ByteString
+readBuf r n = do
+  bs <- readIORef r
+  let (hd, tl) = LBS.splitAt (fromIntegral n) bs
+  writeIORef r tl
+  return hd
+
+peekBuf :: ReadBuffer -> IO (Maybe Word8)
+peekBuf r = (fmap fst . LBS.uncons) <$> readIORef r
diff --git a/lib/hs/src/Thrift/Types.hs b/lib/hs/src/Thrift/Types.hs
index e917e39..b014ac6 100644
--- a/lib/hs/src/Thrift/Types.hs
+++ b/lib/hs/src/Thrift/Types.hs
@@ -16,10 +16,17 @@
 -- under the License.
 --
 
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
 module Thrift.Types where
 
 import Data.Foldable (foldl')
 import Data.Hashable ( Hashable, hashWithSalt )
+import Data.Int
+import Test.QuickCheck.Arbitrary
+import Test.QuickCheck.Gen (elements)
+import Data.Text.Lazy (Text)
+import qualified Data.ByteString.Lazy as LBS
 import qualified Data.HashMap.Strict as Map
 import qualified Data.HashSet as Set
 import qualified Data.Vector as Vector
@@ -28,7 +35,95 @@
   hashWithSalt salt = foldl' hashWithSalt salt . Map.toList
 
 instance (Hashable a) => Hashable (Set.HashSet a) where
-  hashWithSalt salt = foldl' hashWithSalt salt
+  hashWithSalt = foldl' hashWithSalt
 
 instance (Hashable a) => Hashable (Vector.Vector a) where
-  hashWithSalt salt = Vector.foldl' hashWithSalt salt
+  hashWithSalt = Vector.foldl' hashWithSalt
+
+
+type TypeMap = Map.HashMap Int16 (Text, ThriftType)
+
+data ThriftVal = TStruct (Map.HashMap Int16 (Text, ThriftVal))
+               | TMap ThriftType ThriftType [(ThriftVal, ThriftVal)]
+               | TList ThriftType [ThriftVal]
+               | TSet ThriftType [ThriftVal]
+               | TBool Bool
+               | TByte Int8
+               | TI16 Int16
+               | TI32 Int32
+               | TI64 Int64
+               | TString LBS.ByteString
+               | TDouble Double
+                 deriving (Eq, Show)
+
+-- Information is needed here for collection types (ie T_STRUCT, T_MAP,
+-- T_LIST, and T_SET) so that we know what types those collections are
+-- parameterized by.  In most protocols, this cannot be discerned directly
+-- from the data being read.
+data ThriftType
+    = T_STOP
+    | T_VOID
+    | T_BOOL
+    | T_BYTE
+    | T_DOUBLE
+    | T_I16
+    | T_I32
+    | T_I64
+    | T_STRING
+    | T_STRUCT TypeMap
+    | T_MAP ThriftType ThriftType
+    | T_SET ThriftType
+    | T_LIST ThriftType
+      deriving ( Eq, Show )
+
+-- NOTE: when using toEnum information about parametized types is NOT preserved.
+-- This design choice is consistent woth the Thrift implementation in other
+-- languages
+instance Enum ThriftType where
+    fromEnum T_STOP       = 0
+    fromEnum T_VOID       = 1
+    fromEnum T_BOOL       = 2
+    fromEnum T_BYTE       = 3
+    fromEnum T_DOUBLE     = 4
+    fromEnum T_I16        = 6
+    fromEnum T_I32        = 8
+    fromEnum T_I64        = 10
+    fromEnum T_STRING     = 11
+    fromEnum (T_STRUCT _) = 12
+    fromEnum (T_MAP _ _)  = 13
+    fromEnum (T_SET _)    = 14
+    fromEnum (T_LIST _)   = 15
+
+    toEnum 0  = T_STOP
+    toEnum 1  = T_VOID
+    toEnum 2  = T_BOOL
+    toEnum 3  = T_BYTE
+    toEnum 4  = T_DOUBLE
+    toEnum 6  = T_I16
+    toEnum 8  = T_I32
+    toEnum 10 = T_I64
+    toEnum 11 = T_STRING
+    toEnum 12 = T_STRUCT Map.empty
+    toEnum 13 = T_MAP T_VOID T_VOID
+    toEnum 14 = T_SET T_VOID
+    toEnum 15 = T_LIST T_VOID
+    toEnum t = error $ "Invalid ThriftType " ++ show t
+
+data MessageType
+    = M_CALL
+    | M_REPLY
+    | M_EXCEPTION
+      deriving ( Eq, Show )
+
+instance Enum MessageType where
+    fromEnum M_CALL      =  1
+    fromEnum M_REPLY     =  2
+    fromEnum M_EXCEPTION =  3
+
+    toEnum 1 = M_CALL
+    toEnum 2 = M_REPLY
+    toEnum 3 = M_EXCEPTION
+    toEnum t = error $ "Invalid MessageType " ++ show t
+
+instance Arbitrary MessageType where
+  arbitrary = elements [M_CALL, M_REPLY, M_EXCEPTION]
diff --git a/test/hs/DebugProtoTest_Main.hs b/test/hs/DebugProtoTest_Main.hs
index 29393db..fb28963 100755
--- a/test/hs/DebugProtoTest_Main.hs
+++ b/test/hs/DebugProtoTest_Main.hs
@@ -24,7 +24,9 @@
 
 import qualified Control.Exception
 import qualified Data.ByteString.Lazy as DBL
-import qualified Data.Maybe
+import qualified Data.HashMap.Strict as Map
+import qualified Data.HashSet as Set
+import qualified Data.Vector as Vector
 import qualified Network
 
 import Thrift.Protocol.Binary
@@ -61,61 +63,61 @@
     structMethod _ = do
         ThriftTestUtils.serverLog "Got structMethod call"
         return $ Types.CompactProtoTestStruct {
-            Types.f_CompactProtoTestStruct_a_byte = Just 0x01,
-            Types.f_CompactProtoTestStruct_a_i16 = Just 0x02,
-            Types.f_CompactProtoTestStruct_a_i32 = Just 0x03,
-            Types.f_CompactProtoTestStruct_a_i64 = Just 0x04,
-            Types.f_CompactProtoTestStruct_a_double = Just 0.1,
-            Types.f_CompactProtoTestStruct_a_string = Just "abcdef",
-            Types.f_CompactProtoTestStruct_a_binary = Just DBL.empty,
-            Types.f_CompactProtoTestStruct_true_field = Just True,
-            Types.f_CompactProtoTestStruct_false_field = Just False,
-            Types.f_CompactProtoTestStruct_empty_struct_field = Just Types.Empty,
+            Types.compactProtoTestStruct_a_byte = 0x01,
+            Types.compactProtoTestStruct_a_i16 = 0x02,
+            Types.compactProtoTestStruct_a_i32 = 0x03,
+            Types.compactProtoTestStruct_a_i64 = 0x04,
+            Types.compactProtoTestStruct_a_double = 0.1,
+            Types.compactProtoTestStruct_a_string = "abcdef",
+            Types.compactProtoTestStruct_a_binary = DBL.empty,
+            Types.compactProtoTestStruct_true_field = True,
+            Types.compactProtoTestStruct_false_field = False,
+            Types.compactProtoTestStruct_empty_struct_field = Types.Empty,
             
-            Types.f_CompactProtoTestStruct_byte_list = Nothing,
-            Types.f_CompactProtoTestStruct_i16_list = Nothing,
-            Types.f_CompactProtoTestStruct_i32_list = Nothing,
-            Types.f_CompactProtoTestStruct_i64_list = Nothing,
-            Types.f_CompactProtoTestStruct_double_list = Nothing,
-            Types.f_CompactProtoTestStruct_string_list = Nothing,
-            Types.f_CompactProtoTestStruct_binary_list = Nothing,
-            Types.f_CompactProtoTestStruct_boolean_list = Nothing,
-            Types.f_CompactProtoTestStruct_struct_list = Nothing,
+            Types.compactProtoTestStruct_byte_list = Vector.empty,
+            Types.compactProtoTestStruct_i16_list = Vector.empty,
+            Types.compactProtoTestStruct_i32_list = Vector.empty,
+            Types.compactProtoTestStruct_i64_list = Vector.empty,
+            Types.compactProtoTestStruct_double_list = Vector.empty,
+            Types.compactProtoTestStruct_string_list = Vector.empty,
+            Types.compactProtoTestStruct_binary_list = Vector.empty,
+            Types.compactProtoTestStruct_boolean_list = Vector.empty,
+            Types.compactProtoTestStruct_struct_list = Vector.empty,
 
-            Types.f_CompactProtoTestStruct_byte_set = Nothing,
-            Types.f_CompactProtoTestStruct_i16_set = Nothing,
-            Types.f_CompactProtoTestStruct_i32_set = Nothing,
-            Types.f_CompactProtoTestStruct_i64_set = Nothing,
-            Types.f_CompactProtoTestStruct_double_set = Nothing,
-            Types.f_CompactProtoTestStruct_string_set = Nothing,
-            Types.f_CompactProtoTestStruct_binary_set = Nothing,
-            Types.f_CompactProtoTestStruct_boolean_set = Nothing,
-            Types.f_CompactProtoTestStruct_struct_set = Nothing,
+            Types.compactProtoTestStruct_byte_set = Set.empty,
+            Types.compactProtoTestStruct_i16_set = Set.empty,
+            Types.compactProtoTestStruct_i32_set = Set.empty,
+            Types.compactProtoTestStruct_i64_set = Set.empty,
+            Types.compactProtoTestStruct_double_set = Set.empty,
+            Types.compactProtoTestStruct_string_set = Set.empty,
+            Types.compactProtoTestStruct_binary_set = Set.empty,
+            Types.compactProtoTestStruct_boolean_set = Set.empty,
+            Types.compactProtoTestStruct_struct_set = Set.empty,
 
-            Types.f_CompactProtoTestStruct_byte_byte_map = Nothing,
-            Types.f_CompactProtoTestStruct_i16_byte_map = Nothing,
-            Types.f_CompactProtoTestStruct_i32_byte_map = Nothing,
-            Types.f_CompactProtoTestStruct_i64_byte_map = Nothing,
-            Types.f_CompactProtoTestStruct_double_byte_map = Nothing,
-            Types.f_CompactProtoTestStruct_string_byte_map = Nothing,
-            Types.f_CompactProtoTestStruct_binary_byte_map = Nothing,
-            Types.f_CompactProtoTestStruct_boolean_byte_map = Nothing,
+            Types.compactProtoTestStruct_byte_byte_map = Map.empty,
+            Types.compactProtoTestStruct_i16_byte_map = Map.empty,
+            Types.compactProtoTestStruct_i32_byte_map = Map.empty,
+            Types.compactProtoTestStruct_i64_byte_map = Map.empty,
+            Types.compactProtoTestStruct_double_byte_map = Map.empty,
+            Types.compactProtoTestStruct_string_byte_map = Map.empty,
+            Types.compactProtoTestStruct_binary_byte_map = Map.empty,
+            Types.compactProtoTestStruct_boolean_byte_map = Map.empty,
 
-            Types.f_CompactProtoTestStruct_byte_i16_map = Nothing,
-            Types.f_CompactProtoTestStruct_byte_i32_map = Nothing,
-            Types.f_CompactProtoTestStruct_byte_i64_map = Nothing,
-            Types.f_CompactProtoTestStruct_byte_double_map = Nothing,
-            Types.f_CompactProtoTestStruct_byte_string_map = Nothing,
-            Types.f_CompactProtoTestStruct_byte_binary_map = Nothing,
-            Types.f_CompactProtoTestStruct_byte_boolean_map = Nothing,
+            Types.compactProtoTestStruct_byte_i16_map = Map.empty,
+            Types.compactProtoTestStruct_byte_i32_map = Map.empty,
+            Types.compactProtoTestStruct_byte_i64_map = Map.empty,
+            Types.compactProtoTestStruct_byte_double_map = Map.empty,
+            Types.compactProtoTestStruct_byte_string_map = Map.empty,
+            Types.compactProtoTestStruct_byte_binary_map = Map.empty,
+            Types.compactProtoTestStruct_byte_boolean_map = Map.empty,
 
-            Types.f_CompactProtoTestStruct_list_byte_map = Nothing,
-            Types.f_CompactProtoTestStruct_set_byte_map = Nothing,
-            Types.f_CompactProtoTestStruct_map_byte_map = Nothing,
+            Types.compactProtoTestStruct_list_byte_map = Map.empty,
+            Types.compactProtoTestStruct_set_byte_map = Map.empty,
+            Types.compactProtoTestStruct_map_byte_map = Map.empty,
 
-            Types.f_CompactProtoTestStruct_byte_map_map = Nothing,
-            Types.f_CompactProtoTestStruct_byte_set_map = Nothing,
-            Types.f_CompactProtoTestStruct_byte_list_map = Nothing }
+            Types.compactProtoTestStruct_byte_map_map = Map.empty,
+            Types.compactProtoTestStruct_byte_set_map = Map.empty,
+            Types.compactProtoTestStruct_byte_list_map = Map.empty }
 
     methodWithDefaultArgs _ arg = do
         ThriftTestUtils.serverLog $ "Got methodWithDefaultArgs: " ++ show arg
@@ -127,7 +129,7 @@
 instance IIface.Inherited_Iface InheritedHandler where
     identity _ arg = do
         ThriftTestUtils.serverLog $ "Got identity method: " ++ show arg
-        return $ Data.Maybe.fromJust arg
+        return arg
 
 client :: (String, Network.PortID) -> IO ()
 client addr = do
diff --git a/test/hs/Include_Main.hs b/test/hs/Include_Main.hs
index 697ffff..d3977a1 100644
--- a/test/hs/Include_Main.hs
+++ b/test/hs/Include_Main.hs
@@ -4,4 +4,4 @@
 import ThriftTest_Types
 
 main :: IO ()
-main = putStrLn ("Includes work: " ++ (show (IncludeTest (Just  (Bools (Just True) (Just False))))))
+main = putStrLn ("Includes work: " ++ (show (IncludeTest $ Bools True False)))
diff --git a/test/hs/Makefile.am b/test/hs/Makefile.am
index 2e016c4..2629ca1 100644
--- a/test/hs/Makefile.am
+++ b/test/hs/Makefile.am
@@ -35,3 +35,9 @@
 
 clean-local:
 	$(RM) -r gen-hs
+	$(RM) *.hi
+	$(RM) *.o
+
+all: check
+	ghc -igen-hs TestServer.hs
+	ghc -igen-hs TestClient.hs
\ No newline at end of file
diff --git a/test/hs/NameConflictTest_Main.hs b/test/hs/NameConflictTest_Main.hs
index 5d0b17a..7de0f4d 100644
--- a/test/hs/NameConflictTest_Main.hs
+++ b/test/hs/NameConflictTest_Main.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
 module Main where
 
 import qualified Prelude as P
@@ -16,4 +17,4 @@
   P.putStrLn "Values:"
   P.print ([JUST, TRUE, FALSE] :: [Maybe])
   P.print ([LEFT, RIGHT] :: [Either])
-  P.print (Problem_ (P.Just P.True) (P.Just P.False))
+  P.print (Problem_ P.True P.False)
diff --git a/test/hs/TestClient.hs b/test/hs/TestClient.hs
new file mode 100644
index 0000000..35e8397
--- /dev/null
+++ b/test/hs/TestClient.hs
@@ -0,0 +1,231 @@
+--
+-- Licensed to the Apache Software Foundation (ASF) under one
+-- or more contributor license agreements. See the NOTICE file
+-- distributed with this work for additional information
+-- regarding copyright ownership. The ASF licenses this file
+-- to you under the Apache License, Version 2.0 (the
+-- "License"); you may not use this file except in compliance
+-- with the License. You may obtain a copy of the License at
+--
+--   http://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing,
+-- software distributed under the License is distributed on an
+-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+-- KIND, either express or implied. See the License for the
+-- specific language governing permissions and limitations
+-- under the License.
+--
+
+{-# LANGUAGE OverloadedStrings, RecordWildCards, ScopedTypeVariables #-}
+module Main where
+
+import Control.Exception
+import Control.Monad
+import Data.Functor
+import Data.String
+import Network
+import System.Environment
+import System.Exit
+import System.Posix.Unistd
+import qualified Data.HashMap.Strict as Map
+import qualified Data.HashSet as Set
+import qualified Data.Vector as Vector
+
+import ThriftTest_Iface
+import ThriftTest_Types
+import qualified ThriftTest_Client as Client
+
+import Thrift.Transport
+import Thrift.Transport.Handle
+import Thrift.Protocol
+import Thrift.Protocol.Binary
+import Thrift.Protocol.Compact
+import Thrift.Protocol.JSON
+
+data Options = Options
+  { host         :: String
+  , port         :: Int
+  , domainSocket :: String
+  , transport    :: String
+  , protocol     :: ProtocolType
+  , ssl          :: Bool
+  , testLoops    :: Int
+  }
+  deriving (Show, Eq)
+
+data ProtocolType = Binary
+                  | Compact
+                  | JSON
+                  deriving (Show, Eq)
+
+getProtocol :: String -> ProtocolType
+getProtocol "binary"  = Binary
+getProtocol "compact" = Compact
+getProtocol "json"    = JSON
+getProtocol p = error $ "Unsupported Protocol: " ++ p
+
+defaultOptions :: Options
+defaultOptions = Options
+  { port         = 9090
+  , domainSocket = ""
+  , host         = "localhost"
+  , transport    = "framed"
+  , protocol     = Binary
+  , ssl          = False
+  , testLoops    = 1
+  }
+
+runClient :: (Protocol p, Transport t) => p t -> IO ()
+runClient p = do
+  let prot = (p,p)
+  putStrLn "Starting Tests"
+              
+  -- VOID Test
+  Client.testVoid prot
+  
+  -- String Test
+  s <- Client.testString prot "Test"
+  when (s /= "Test") exitFailure
+
+  -- Byte Test
+  byte <- Client.testByte prot 1
+  when (byte /= 1) exitFailure
+  
+  -- I32 Test
+  i32 <- Client.testI32 prot (-1)
+  when (i32 /= -1) exitFailure
+  
+  -- I64 Test
+  i64 <- Client.testI64 prot (-34359738368)
+  when (i64 /= -34359738368) exitFailure
+
+  -- Double Test
+  dub <- Client.testDouble prot (-5.2098523)
+  when (abs (dub + 5.2098523) > 0.001) exitFailure
+
+  -- Struct Test
+  let structIn = Xtruct{ xtruct_string_thing = "Zero"
+                       , xtruct_byte_thing   = 1
+                       , xtruct_i32_thing    = -3
+                       , xtruct_i64_thing    = -5
+                       }
+  structOut <- Client.testStruct prot structIn 
+  when (structIn /= structOut) exitFailure
+
+  -- Nested Struct Test
+  let nestIn = Xtruct2{ xtruct2_byte_thing   = 1
+                      , xtruct2_struct_thing = structIn
+                      , xtruct2_i32_thing    = 5
+                      }
+  nestOut <- Client.testNest prot nestIn
+  when (nestIn /= nestOut) exitSuccess
+  
+  -- Map Test
+  let mapIn = Map.fromList $ map (\i -> (i, i-10)) [1..5]
+  mapOut <- Client.testMap prot mapIn
+  when (mapIn /= mapOut) exitSuccess
+  
+  -- Set Test
+  let setIn = Set.fromList [-2..3]
+  setOut <- Client.testSet prot setIn
+  when (setIn /= setOut) exitFailure
+  
+  -- List Test
+  let listIn = Vector.fromList [-2..3]
+  listOut <- Client.testList prot listIn
+  when (listIn /= listOut) exitFailure
+  
+  -- Enum Test
+  numz1 <- Client.testEnum prot ONE
+  when (numz1 /= ONE) exitFailure
+
+  numz2 <- Client.testEnum prot TWO
+  when (numz2 /= TWO) exitFailure
+
+  numz5 <- Client.testEnum prot FIVE
+  when (numz5 /= FIVE) exitFailure
+
+  -- Typedef Test
+  uid <- Client.testTypedef prot 309858235082523
+  when (uid /= 309858235082523) exitFailure
+  
+  -- Nested Map Test
+  _ <- Client.testMapMap prot 1
+  
+  -- Exception Test
+  exn1 <- try $ Client.testException prot "Xception"
+  case exn1 of
+    Left (Xception _ _) -> return ()
+    _ -> putStrLn (show exn1) >> exitFailure
+  
+  exn2 <- try $ Client.testException prot "TException"
+  case exn2 of
+    Left (_ :: SomeException) -> return ()
+    Right _ -> exitFailure
+  
+  exn3 <- try $ Client.testException prot "success"
+  case exn3 of
+    Left (_ :: SomeException) -> exitFailure
+    Right _ -> return ()
+  
+  -- Multi Exception Test
+  multi1 <- try $ Client.testMultiException prot "Xception" "test 1"
+  case multi1 of
+    Left (Xception _ _) -> return ()
+    _ -> exitFailure
+
+  multi2 <- try $ Client.testMultiException prot "Xception2" "test 2"
+  case multi2 of
+    Left (Xception2 _ _) -> return ()
+    _ -> exitFailure
+
+  multi3 <- try $ Client.testMultiException prot "success" "test 3"
+  case multi3 of
+    Left (_ :: SomeException) -> exitFailure
+    Right _ -> return ()
+
+
+main :: IO ()
+main = do
+  options <- flip parseFlags defaultOptions <$> getArgs
+  case options of
+    Nothing -> showHelp
+    Just Options{..} -> do
+      handle <- hOpen (host, PortNumber $ fromIntegral port)
+      let client = case protocol of
+            Binary  -> runClient $ BinaryProtocol handle
+            Compact -> runClient $ CompactProtocol handle
+            JSON    -> runClient $ JSONProtocol handle
+      replicateM_ testLoops client      
+      putStrLn "COMPLETED SUCCESSFULLY"
+
+parseFlags :: [String] -> Options -> Maybe Options
+parseFlags (flag : arg : flags) opts
+  | flag == "--port"          = parseFlags flags opts{ port = read arg }
+  | flag == "--domain-socket" = parseFlags flags opts{ domainSocket = arg }
+  | flag == "--host"          = parseFlags flags opts{ host = arg }
+  | flag == "--transport"     = parseFlags flags opts{ transport = arg }
+  | flag == "--protocol"      = parseFlags flags opts{ protocol = getProtocol arg }
+  | flag == "-n" ||
+    flag == "--testloops"     = parseFlags flags opts{ testLoops = read arg }
+parseFlags (flag : flags) opts
+  | flag == "-h"     = Nothing
+  | flag == "--help" = Nothing
+  | flag == "--ssl"  = parseFlags flags opts{ ssl = True }
+  | flag == "--processor-events" ||
+    otherwise = parseFlags flags opts
+parseFlags [] opts = Just opts
+
+showHelp :: IO ()
+showHelp = putStrLn
+  "Allowed options:\n\
+  \  -h [ --help ]               produce help message\n\
+  \  --host arg (=localhost)     Host to connect\n\
+  \  --port arg (=9090)          Port number to connect\n\
+  \  --domain-socket arg         Domain Socket (e.g. /tmp/ThriftTest.thrift),\n\ 
+  \                              instead of host and port\n\
+  \  --transport arg (=buffered) Transport: buffered, framed, http, evhttp\n\
+  \  --protocol arg (=binary)    Protocol: binary, compact, json\n\
+  \  --ssl                       Encrypted Transport using SSL\n\
+  \  -n [ --testloops ] arg (=1) Number of Tests"
\ No newline at end of file
diff --git a/test/hs/TestServer.hs b/test/hs/TestServer.hs
new file mode 100644
index 0000000..340b58b
--- /dev/null
+++ b/test/hs/TestServer.hs
@@ -0,0 +1,269 @@
+--
+-- Licensed to the Apache Software Foundation (ASF) under one
+-- or more contributor license agreements. See the NOTICE file
+-- distributed with this work for additional information
+-- regarding copyright ownership. The ASF licenses this file
+-- to you under the Apache License, Version 2.0 (the
+-- "License"); you may not use this file except in compliance
+-- with the License. You may obtain a copy of the License at
+--
+--   http://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing,
+-- software distributed under the License is distributed on an
+-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+-- KIND, either express or implied. See the License for the
+-- specific language governing permissions and limitations
+-- under the License.
+--
+
+{-# LANGUAGE OverloadedStrings,RecordWildCards #-}
+module Main where
+
+import Control.Exception
+import Control.Monad
+import Data.Functor
+import Data.HashMap.Strict (HashMap)
+import Data.List
+import Data.String
+import Network
+import System.Environment
+import System.Exit
+import System.IO
+import System.Posix.Unistd
+import qualified Data.HashMap.Strict as Map
+import qualified Data.HashSet as Set
+import qualified Data.Text.Lazy as Text
+import qualified Data.Vector as Vector
+
+import ThriftTest
+import ThriftTest_Iface
+import ThriftTest_Types
+
+import Thrift
+import Thrift.Server
+import Thrift.Transport.Framed
+import Thrift.Transport.Handle
+import Thrift.Protocol.Binary
+import Thrift.Protocol.Compact
+import Thrift.Protocol.JSON
+
+data Options = Options
+  { port         :: Int
+  , domainSocket :: String
+  , serverType   :: ServerType
+  , transport    :: String
+  , protocol     :: ProtocolType
+  , ssl          :: Bool
+  , workers      :: Int
+  }
+  
+data ServerType = Simple
+                | ThreadPool
+                | Threaded
+                | NonBlocking
+                deriving (Show, Eq)
+
+instance IsString ServerType where
+  fromString "simple"      = Simple
+  fromString "thread-pool" = ThreadPool
+  fromString "threaded"    = Threaded
+  fromString "nonblocking" = NonBlocking
+  fromString _ = error "not a valid server type"
+
+data ProtocolType = Binary
+                  | Compact
+                  | JSON
+
+getProtocol :: String -> ProtocolType
+getProtocol "binary"  = Binary
+getProtocol "compact" = Compact
+getProtocol "json"    = JSON
+getProtocol p = error $"Unsupported Protocol: " ++ p
+
+defaultOptions :: Options
+defaultOptions = Options
+  { port         = 9090
+  , domainSocket = ""
+  , serverType   = Threaded
+  , transport    = "framed"
+  , protocol     = Binary
+  , ssl          = False
+  , workers      = 4
+  }
+
+stringifyMap :: (Show a, Show b) => Map.HashMap a b -> String
+stringifyMap = intercalate ", " . map joinKV . Map.toList
+  where joinKV (k, v) = show k ++ " => " ++ show v
+
+stringifySet :: Show a => Set.HashSet a -> String
+stringifySet = intercalate ", " . map show . Set.toList
+
+stringifyList :: Show a => Vector.Vector a -> String
+stringifyList = intercalate ", " . map show . Vector.toList
+
+data TestHandler = TestHandler
+instance ThriftTest_Iface TestHandler where  
+  testVoid _ = putStrLn "testVoid()"
+
+  testString _ s = do
+    putStrLn $ "testString(" ++ show s ++ ")"
+    return s
+
+  testByte _ x = do
+    putStrLn $ "testByte(" ++ show x ++ ")"
+    return x
+
+  testI32 _ x = do
+    putStrLn $ "testI32(" ++ show x ++ ")"
+    return x
+
+  testI64 _ x = do
+    putStrLn $ "testI64(" ++ show x ++ ")"
+    return x
+    
+  testDouble _ x = do
+    putStrLn $ "testDouble(" ++ show x ++ ")"
+    return x
+
+  testStruct _ struct@Xtruct{..} = do
+    putStrLn $ "testStruct({" ++ show xtruct_string_thing
+                      ++ ", " ++ show xtruct_byte_thing 
+                      ++ ", " ++ show xtruct_i32_thing
+                      ++ ", " ++ show xtruct_i64_thing
+                      ++ "})"
+    return struct
+
+  testNest _ nest@Xtruct2{..} = do
+    let Xtruct{..} = xtruct2_struct_thing
+    putStrLn $ "testNest({" ++ show xtruct2_byte_thing
+                   ++ "{, " ++ show xtruct_string_thing
+                   ++  ", " ++ show xtruct_byte_thing
+                   ++  ", " ++ show xtruct_i32_thing
+                   ++  ", " ++ show xtruct_i64_thing
+                   ++ "}, " ++ show xtruct2_i32_thing
+    return nest
+
+  testMap _ m = do
+    putStrLn $ "testMap({" ++ stringifyMap m ++ "})"
+    return m
+            
+  testStringMap _ m = do
+    putStrLn $ "testStringMap(" ++ stringifyMap m ++ "})"
+    return m
+
+  testSet _ x = do
+    putStrLn $ "testSet({" ++ stringifySet x ++ "})"
+    return x
+
+  testList _ x = do
+    putStrLn $ "testList(" ++ stringifyList x ++ "})"
+    return x
+
+  testEnum _ x = do
+    putStrLn $ "testEnum(" ++ show x ++ ")"
+    return x
+
+  testTypedef _ x = do
+    putStrLn $ "testTypedef(" ++ show x ++ ")"
+    return x
+
+  testMapMap _ x = do
+    putStrLn $ "testMapMap(" ++ show x ++ ")"
+    return $ Map.fromList [ (-4, Map.fromList [ (-4, -4)
+                                              , (-3, -3)
+                                              , (-2, -2)
+                                              , (-1, -1)
+                                              ])
+                          , (4,  Map.fromList [ (1, 1)
+                                              , (2, 2)
+                                              , (3, 3)
+                                              , (4, 4)
+                                              ])
+                          ]
+
+  testInsanity _ x = do
+    putStrLn "testInsanity()"
+    return $ Map.fromList [ (1, Map.fromList [ (TWO  , x)
+                                             , (THREE, x)
+                                             ])
+                          , (2, Map.fromList [ (SIX, default_Insanity)
+                                             ])
+                          ]
+
+  testMulti _ byte i32 i64 _ _ _ = do
+    putStrLn "testMulti()"
+    return Xtruct{ xtruct_string_thing = Text.pack "Hello2"
+                 , xtruct_byte_thing   = byte
+                 , xtruct_i32_thing    = i32
+                 , xtruct_i64_thing    = i64
+                 }
+                                        
+  testException _ s = do
+    putStrLn $ "testException(" ++ show s ++ ")"
+    case s of
+      "Xception"   -> throw $ Xception 1001 s
+      "TException" -> throw ThriftException
+      _ -> return ()
+
+  testMultiException _ s1 s2 = do
+    putStrLn $ "testMultiException(" ++ show s1 ++ ", " ++ show s2 ++  ")"
+    case s1 of
+      "Xception"   -> throw $ Xception 1001 "This is an Xception" 
+      "Xception2"  -> throw $ Xception2 2002 default_Xtruct 
+      "TException" -> throw ThriftException
+      _ -> return default_Xtruct{ xtruct_string_thing = s2 }
+
+  testOneway _ i = do
+    putStrLn $ "testOneway(" ++ show i ++ "): Sleeping..."
+    sleep (fromIntegral i)
+    putStrLn $ "testOneway(" ++ show i ++ "): done sleeping!"
+
+main :: IO ()
+main = do
+  options <- flip parseFlags defaultOptions <$> getArgs
+  case options of
+    Nothing -> showHelp
+    Just Options{..} -> do
+      putStrLn $ "Starting \"" ++ show serverType ++ "\" server (" ++
+        show transport ++ ") listen on: " ++ domainSocket ++ show port
+      case protocol of
+        Binary  -> runServer BinaryProtocol port
+        Compact -> runServer CompactProtocol port
+        JSON    -> runServer JSONProtocol port
+      where
+        runServer p = runThreadedServer (accepter p) TestHandler ThriftTest.process . PortNumber . fromIntegral
+        accepter p s = do
+          (h, _, _) <- accept s
+          return (p h, p h)
+
+parseFlags :: [String] -> Options -> Maybe Options
+parseFlags (flag : arg : flags) opts
+  | flag == "--port"          = parseFlags flags opts{ port = read arg }
+  | flag == "--domain-socket" = parseFlags flags opts{ domainSocket = arg }
+  | flag == "--server-type"   = parseFlags flags opts{ serverType = fromString arg }
+  | flag == "--transport"     = parseFlags flags opts{ transport = arg }
+  | flag == "--protocol"      = parseFlags flags opts{ protocol = getProtocol arg }
+  | flag == "-n" ||
+    flag == "--workers"       = parseFlags flags opts{ workers = read arg }
+parseFlags (flag : flags) opts
+  | flag == "-h"     = Nothing
+  | flag == "--help" = Nothing
+  | flag == "--ssl"  = parseFlags flags opts{ ssl = True }
+  | flag == "--processor-events" = parseFlags flags opts
+parseFlags [] opts = Just opts
+
+showHelp :: IO ()
+showHelp = putStrLn
+  "Allowed options:\n\
+  \  -h [ --help ]               produce help message\n\
+  \  --port arg (=9090)          Port number to listen\n\
+  \  --domain-socket arg         Unix Domain Socket (e.g. /tmp/ThriftTest.thrift)\n\
+  \  --server-type arg (=simple) type of server, \"simple\", \"thread-pool\",\n\
+  \                              \"threaded\", or \"nonblocking\"\n\
+  \  --transport arg (=buffered) transport: buffered, framed, http\n\
+  \  --protocol arg (=binary)    protocol: binary, compact, json\n\
+  \  --ssl                       Encrypted Transport using SSL\n\
+  \  --processor-events          processor-events\n\
+  \  -n [ --workers ] arg (=4)   Number of thread pools workers. Only valid for\n\ 
+  \                              thread-pool server type"
\ No newline at end of file
diff --git a/test/hs/ThriftTestUtils.hs b/test/hs/ThriftTestUtils.hs
index 93fa122..9c19b56 100644
--- a/test/hs/ThriftTestUtils.hs
+++ b/test/hs/ThriftTestUtils.hs
@@ -60,6 +60,6 @@
     Control.Concurrent.threadDelay $ 500 * 1000 -- unit is in _micro_seconds
     Control.Concurrent.yield
 
-    _ <- client serverAddress
+    client serverAddress
 
     testLog "SUCCESS"
diff --git a/test/hs/ThriftTest_Main.hs b/test/hs/ThriftTest_Main.hs
index 3612935..1139506 100755
--- a/test/hs/ThriftTest_Main.hs
+++ b/test/hs/ThriftTest_Main.hs
@@ -47,124 +47,76 @@
 instance Iface.ThriftTest_Iface TestHandler where
     testVoid _ = return ()
 
-    testString _ (Just s) = do
+    testString _ s = do
         ThriftTestUtils.serverLog $ show s
         return s
 
-    testString _ Nothing = do
-        error $ "Unsupported testString form"
-
-    testByte _ (Just x) = do
+    testByte _ x = do
         ThriftTestUtils.serverLog $ show x
         return x
 
-    testByte _ Nothing = do
-        error $ "Unsupported testByte form"
-
-    testI32 _ (Just x) = do
+    testI32 _ x = do
         ThriftTestUtils.serverLog $ show x
         return x
 
-    testI32 _ Nothing = do
-        error $ "Unsupported testI32 form"
-
-    testI64 _ (Just x) = do
+    testI64 _ x = do
         ThriftTestUtils.serverLog $ show x
         return x
 
-    testI64 _ Nothing = do
-        error $ "Unsupported testI64 form"
-
-    testDouble _ (Just x) = do
+    testDouble _ x = do
         ThriftTestUtils.serverLog $ show x
         return x
 
-    testDouble _ Nothing = do
-        error $ "Unsupported testDouble form"
-
-    testStruct _ (Just x) = do
+    testStruct _ x = do
         ThriftTestUtils.serverLog $ show x
         return x
 
-    testStruct _ Nothing = do
-        error $ "Unsupported testStruct form"
-
-    testNest _ (Just x) = do
+    testNest _ x = do
         ThriftTestUtils.serverLog $ show x
         return x
 
-    testNest _ Nothing = do
-        error $ "Unsupported testNest form"
-
-    testMap _ (Just x) = do
+    testMap _ x = do
         ThriftTestUtils.serverLog $ show x
         return x
 
-    testMap _ Nothing = do
-        error $ "Unsupported testMap form"
-
-    testStringMap _ (Just x) = do
+    testStringMap _ x = do
         ThriftTestUtils.serverLog $ show x
         return x
 
-    testStringMap _ Nothing = do
-        error $ "Unsupported testMap form"
-
-    testSet _ (Just x) = do
+    testSet _ x = do
         ThriftTestUtils.serverLog $ show x
         return x
 
-    testSet _ Nothing = do
-        error $ "Unsupported testSet form"
-
-    testList _ (Just x) = do
+    testList _ x = do
         ThriftTestUtils.serverLog $ show x
         return x
 
-    testList _ Nothing = do
-        error $ "Unsupported testList form"
-
-    testEnum _ (Just x) = do
+    testEnum _ x = do
         ThriftTestUtils.serverLog $ show x
         return x
 
-    testEnum _ Nothing = do
-        error $ "Unsupported testEnum form"
-
-    testTypedef _ (Just x) = do
+    testTypedef _ x = do
         ThriftTestUtils.serverLog $ show x
         return x
 
-    testTypedef _ Nothing = do
-        error $ "Unsupported testTypedef form"
-
-    testMapMap _ (Just _) = do
+    testMapMap _ _ = do
         return (Map.fromList [(1, Map.fromList [(2, 2)])])
 
-    testMapMap _ Nothing = do
-        error $ "Unsupported testMapMap form"
-
-    testInsanity _ (Just x) = do
+    testInsanity _ x = do
         return (Map.fromList [(1, Map.fromList [(Types.ONE, x)])])
 
-    testInsanity _ Nothing = do
-        error $ "Unsupported testInsanity form"
-
     testMulti _ _ _ _ _ _ _ = do
-        return (Types.Xtruct Nothing Nothing Nothing Nothing)
+        return (Types.Xtruct "" 0 0 0)
 
     testException _ _ = do
-        Control.Exception.throw (Types.Xception (Just 1) (Just "bya"))
+        Control.Exception.throw (Types.Xception 1 "bya")
 
     testMultiException _ _ _ = do
-        Control.Exception.throw (Types.Xception (Just 1) (Just "xyz"))
+        Control.Exception.throw (Types.Xception 1 "xyz")
 
-    testOneway _ (Just i) = do
+    testOneway _ i = do
         ThriftTestUtils.serverLog $ show i
 
-    testOneway _ Nothing = do
-        error $ "Unsupported testOneway form"
-
 
 client :: (String, Network.PortID) -> IO ()
 client addr = do
@@ -210,7 +162,7 @@
     v13 <- Client.testSet ps (Set.fromList [1,2,3,4,5])
     ThriftTestUtils.clientLog $ show v13
 
-    v14 <- Client.testStruct ps (Types.Xtruct (Just "hi") (Just 4) (Just 5) Nothing)
+    v14 <- Client.testStruct ps (Types.Xtruct "hi" 4 5 0)
     ThriftTestUtils.clientLog $ show v14
 
     (testException ps "bad") `Control.Exception.catch` testExceptionHandler
@@ -222,7 +174,7 @@
 
     tClose to
   where testException ps msg = do
-            Client.testException ps "e"
+            _ <- Client.testException ps "e"
             ThriftTestUtils.clientLog msg
             return ()
 
diff --git a/test/hs/run-test.sh b/test/hs/run-test.sh
old mode 100644
new mode 100755
diff --git a/test/test.sh b/test/test.sh
index 2f74739..5d06e47 100755
--- a/test/test.sh
+++ b/test/test.sh
@@ -208,6 +208,95 @@
 ruby_transports="buffered framed"
 ruby_sockets="ip"
 
+hs_protocols="binary compact json"
+hs_transports="buffered"
+hs_sockets="ip"
+
+######### hs client - hs server ###############
+for proto in $hs_protocols; do
+  for trans in $hs_transports; do
+    for sock in $hs_sockets; do
+      case "$sock" in
+       "ip" )     extraparam="";;
+       "ip-ssl" ) extraparam="--ssl";;
+       "domain" ) extraparam="--domain-socket=/tmp/ThriftTest.thrift";;
+      esac
+      do_test "hs-hs"   "${proto}" "${trans}-${sock}" \
+              "hs/TestClient --protocol ${proto} --transport ${trans} ${extraparam}" \
+              "hs/TestServer --protocol ${proto} --transport ${trans} ${extraparam}" \
+              "2" "0.1"
+    done
+  done
+done
+
+######### hs client - cpp server ###############
+for proto in $(intersection "${hs_protocols}" "${cpp_protocols}"); do
+  for trans in  $(intersection "${hs_transports}" "${cpp_transports}"); do
+    for sock in $(intersection "${hs_sockets}" "${cpp_sockets}"); do
+      case "$sock" in
+       "ip" )     extraparam="";;
+       "ip-ssl" ) extraparam="--ssl";;
+       "domain" ) extraparam="--domain-socket=/tmp/ThriftTest.thrift";;
+      esac
+      do_test "hs-cpp"   "${proto}" "${trans}-${sock}" \
+              "hs/TestClient --protocol ${proto} --transport ${trans} ${extraparam}" \
+              "cpp/TestServer --protocol=${proto} --transport=${trans} ${extraparam}" \
+              "2" "0.1"
+    done
+  done
+done
+
+######### cpp client - hs server ###############
+for proto in $(intersection "${hs_protocols}" "${cpp_protocols}"); do
+  for trans in  $(intersection "${hs_transports}" "${cpp_transports}"); do
+    for sock in $(intersection "${hs_sockets}" "${cpp_sockets}"); do
+      case "$sock" in
+       "ip" )     extraparam="";;
+       "ip-ssl" ) extraparam="--ssl";;
+       "domain" ) extraparam="--domain-socket=/tmp/ThriftTest.thrift";;
+      esac
+      do_test "cpp-hs"   "${proto}" "${trans}-${sock}" \
+              "cpp/TestClient --protocol=${proto} --transport=${trans} ${extraparam}" \
+              "hs/TestServer --protocol ${proto} --transport ${trans} ${extraparam}" \
+              "2" "0.1"
+    done
+  done
+done
+
+######### hs client - java server ###############
+for proto in $(intersection "${hs_protocols}" "${java_protocols}"); do
+  for trans in  $(intersection "${hs_transports}" "${java_transports}"); do
+    for sock in $(intersection "${hs_sockets}" "${java_sockets}"); do
+      case "$sock" in
+       "ip" )     extraparam="";;
+       "ip-ssl" ) extraparam="--ssl";;
+       "domain" ) extraparam="--domain-socket=/tmp/ThriftTest.thrift";;
+      esac
+      do_test "hs-java" "${proto}" "${trans}-${sock}" \
+              "hs/TestClient --protocol ${proto} --transport ${trans} ${extraparam}" \
+	      "ant -f  ../lib/java/build.xml -Dno-gen-thrift=\"\" -Dtestargs \"--protocol=${proto} --transport=${trans} ${extraparam}\" run-testserver" \
+              "cpp/TestServer --protocol=${proto} --transport=${trans} ${extraparam}" \
+              "5" "1"
+    done
+  done
+done
+
+######### java client - hs server ###############
+for proto in $(intersection "${hs_protocols}" "${java_protocols}"); do
+  for trans in  $(intersection "${hs_transports}" "${java_transports}"); do
+    for sock in $(intersection "${hs_sockets}" "${java_sockets}"); do
+      case "$sock" in
+       "ip" )     extraparam="";;
+       "ip-ssl" ) extraparam="--ssl";;
+       "domain" ) extraparam="--domain-socket=/tmp/ThriftTest.thrift";;
+      esac
+      do_test "java-hs" "${proto}" "${trans}-${sock}" \
+              "ant -f  ../lib/java/build.xml -Dno-gen-thrift=\"\" -Dtestargs \"--protocol=${proto} --transport=${trans} ${extraparam}\" run-testclient" \
+              "hs/TestServer --protocol ${proto} --transport ${trans} ${extraparam}" \
+              "5" "1"
+    done
+  done
+done
 
 ######### java client - java server #############
 for proto in $java_protocols; do
@@ -860,7 +949,6 @@
   done
 done
 
-
 do_test "js-java"   "json"  "http-ip" \
         "" \
         "ant -f  ../lib/js/test/build.xml unittest" \
diff --git a/tutorial/hs/HaskellClient.hs b/tutorial/hs/HaskellClient.hs
index 18d72ad..bd29df0 100644
--- a/tutorial/hs/HaskellClient.hs
+++ b/tutorial/hs/HaskellClient.hs
@@ -48,27 +48,27 @@
   printf "1+1=%d\n" sum
 
 
-  let work = Work { f_Work_op = Just DIVIDE,
-                    f_Work_num1 = Just 1,
-                    f_Work_num2 = Just 0,
-                    f_Work_comment = Nothing
+  let work = Work { work_op = DIVIDE,
+                    work_num1 = 1,
+                    work_num2 = 0,
+                    work_comment = Nothing
                   }
 
   Control.Exception.catch (printf "1/0=%d\n" =<< Client.calculate client 1 work)
         (\e -> printf "InvalidOperation %s\n" (show (e :: InvalidOperation)))
 
 
-  let work = Work { f_Work_op = Just SUBTRACT,
-                    f_Work_num1 = Just 15,
-                    f_Work_num2 = Just 10,
-                    f_Work_comment = Nothing
+  let work = Work { work_op = SUBTRACT,
+                    work_num1 = 15,
+                    work_num2 = 10,
+                    work_comment = Nothing
                   }
 
   diff <- Client.calculate client 1 work
   printf "15-10=%d\n" diff
 
   log <- SClient.getStruct client 1
-  printf "Check log: %s\n"  $ fromJust $ unpack `fmap` f_SharedStruct_value log
+  printf "Check log: %s\n" $ unpack $ sharedStruct_value log
 
   -- Close!
   tClose transport
diff --git a/tutorial/hs/HaskellServer.hs b/tutorial/hs/HaskellServer.hs
index 212e722..77f1679 100644
--- a/tutorial/hs/HaskellServer.hs
+++ b/tutorial/hs/HaskellServer.hs
@@ -49,7 +49,7 @@
 instance SharedService_Iface CalculatorHandler where
   getStruct self k = do
     myLog <- readMVar (mathLog self)
-    return $ (myLog ! (fromJust k))
+    return $ (myLog ! k)
 
 
 instance Calculator_Iface CalculatorHandler where
@@ -57,8 +57,8 @@
     print "ping()"
 
   add _ n1 n2 = do
-    printf "add(%d,%d)\n" (fromJust n1) (fromJust n2)
-    return ((fromJust n1)+(fromJust n2))
+    printf "add(%d,%d)\n" n1 n2
+    return (n1 + n2)
 
   calculate self mlogid mwork = do
     printf "calculate(%d, %s)\n" logid (show work)
@@ -74,27 +74,24 @@
                     if num2 work == 0 then
                         throw $
                               InvalidOperation {
-                                 f_InvalidOperation_what = Just $ fromIntegral $ fromEnum $ op work,
-                                 f_InvalidOperation_why = Just "Cannot divide by 0"
+                                 invalidOperation_what = fromIntegral $ fromEnum $ op work,
+                                 invalidOperation_why = "Cannot divide by 0"
                                             }
                     else
                         num1 work `div` num2 work
 
-    let logEntry = SharedStruct (Just logid) (Just (fromString $ show $ val))
+    let logEntry = SharedStruct logid (fromString $ show $ val)
     modifyMVar_ (mathLog self) $ return .(M.insert logid logEntry)
 
     return $! val
 
    where
      -- stupid dynamic languages f'ing it up
-     num1 = fromJust . f_Work_num1
-     num2 = fromJust . f_Work_num2
-     op = fromJust . f_Work_op
-     logid = fromJust mlogid
-     work = fromJust mwork
-
-
-    --return val
+     num1 = work_num1
+     num2 = work_num2
+     op = work_op
+     logid = mlogid
+     work = mwork
 
   zip _ =
     print "zip()"
diff --git a/tutorial/hs/ThriftTutorial.cabal b/tutorial/hs/ThriftTutorial.cabal
index 6cc29e8..b38fc5c 100755
--- a/tutorial/hs/ThriftTutorial.cabal
+++ b/tutorial/hs/ThriftTutorial.cabal
@@ -37,7 +37,7 @@
   Hs-Source-Dirs:
     ., gen-hs/
   Build-Depends:
-    base >= 4, base < 5, network, ghc-prim, containers, thrift, vector, unordered-containers, text, hashable, bytestring
+    base >= 4, base < 5, network, ghc-prim, containers, thrift, vector, unordered-containers, text, hashable, bytestring, QuickCheck
   Extensions:
     DeriveDataTypeable,
     ExistentialQuantification,
@@ -53,7 +53,7 @@
   Hs-Source-Dirs:
     ., gen-hs/
   Build-Depends:
-    base >= 4, base < 5, network, ghc-prim, containers, thrift, vector
+    base >= 4, base < 5, network, ghc-prim, containers, thrift, vector, QuickCheck
   Extensions:
     DeriveDataTypeable,
     ExistentialQuantification,