diff --git a/lib/hs/README b/lib/hs/README
new file mode 100644
index 0000000..d7b2232
--- /dev/null
+++ b/lib/hs/README
@@ -0,0 +1,22 @@
+Haskell Thrift Bindings
+
+Running: you need -fglasgow-exts.
+
+Enums: become haskell data types. Use fromEnum to get out the int value.
+
+Structs: become records. Field labels are ugly, of the form f_STRUCTNAME_FIELDNAME. All fields are Maybe types.
+
+Exceptions: identical to structs. Throw them with throwDyn. Catch them with catchDyn.
+
+Client: just a bunch of functions. You may have to import a bunch of client files to deal with inheritance.
+
+Interface: You should only have to import the last one in the chain of inheritors. To make an interface, declare a label:
+data MyIface = MyIface
+and then declare it an instance of each iface class, starting with the superest class and proceding down (all the while defining the methods).
+Then pass your label to process as the handler.
+
+Processor: Just a function that takes a handler label, protocols. It calls the superclasses process if there is a superclass.
+
+
+Note: Protocols implement flush as well as transports and do not have a getTransport method. This is because I couldn't get getTransport to typecheck. Shrug.
+
diff --git a/lib/hs/TODO b/lib/hs/TODO
new file mode 100644
index 0000000..1368173
--- /dev/null
+++ b/lib/hs/TODO
@@ -0,0 +1,2 @@
+The library could stand to be built up more.
+Many modules need export lists.
diff --git a/lib/hs/src/TBinaryProtocol.hs b/lib/hs/src/TBinaryProtocol.hs
new file mode 100644
index 0000000..dd5212d
--- /dev/null
+++ b/lib/hs/src/TBinaryProtocol.hs
@@ -0,0 +1,110 @@
+module TBinaryProtocol (TBinaryProtocol(..)) where
+    import Thrift
+    import Data.Bits
+    import Data.Int
+    import GHC.Exts
+    import GHC.Prim
+    import GHC.Word
+    import Control.Exception
+
+    data TBinaryProtocol a = (TTransport a) => TBinaryProtocol a
+
+    version_mask = 0xffff0000
+    version_1 = 0x80010000;
+    
+    getByte i b= 255 .&. (shiftR i (8*b))
+    getBytes i 0 = []
+    getBytes i n = (toEnum (getByte i (n-1)) :: Char):(getBytes i (n-1))
+    
+    floatBits :: Double -> Word64
+    floatBits (D# d#) = W64# (unsafeCoerce# d#)
+
+    floatOfBits :: Word64 -> Double
+    floatOfBits (W64# b#) = D# (unsafeCoerce# b#)
+
+    composeBytesH :: [Char] -> Int -> Word32
+    composeBytesH [] n = 0
+    composeBytesH (h:t) n = (shiftL (fromIntegral (fromEnum h) :: Word32) (8*n)) .|. (composeBytesH t (n-1))
+    compBytes :: [Char] -> Word32
+    compBytes b = composeBytesH b ((length b)-1)
+
+    composeBytes64H :: [Char] -> Int -> Word64
+    composeBytes64H [] n = 0
+    composeBytes64H (h:t) n = (shiftL (fromIntegral (fromEnum h) :: Word64) (8*n)) .|. (composeBytes64H t (n-1))
+    compBytes64 :: [Char] -> Word64
+    compBytes64 b = composeBytes64H b ((length b)-1)
+    instance TTransport a =>  Protocol (TBinaryProtocol a) where
+                       writeBool (TBinaryProtocol tr) b = twrite tr (if b then [toEnum 1::Char] else [toEnum 0::Char])
+                       writeByte (TBinaryProtocol tr) b = twrite tr (getBytes b 1)
+                       writeI16 (TBinaryProtocol tr) b = twrite tr (getBytes b 2)
+                       writeI32 (TBinaryProtocol tr) b = twrite tr (getBytes b 4)
+                       writeI64 (TBinaryProtocol tr) b = twrite tr (getBytes b 8)
+                       writeDouble (TBinaryProtocol tr) b = writeI64 (TBinaryProtocol tr) (fromIntegral (floatBits b) :: Int)
+                       writeString (TBinaryProtocol tr) s = do twrite tr (getBytes (length s) 4)
+                                                               twrite tr s
+                       writeBinary = writeString
+                       writeMessageBegin (TBinaryProtocol tr) (n,t,s) = do writeI32 (TBinaryProtocol tr) (version_1 .|. (fromEnum t))
+                                                                           writeString (TBinaryProtocol tr) n                                                                           
+                                                                           writeI32 (TBinaryProtocol tr) s
+                       writeMessageEnd (TBinaryProtocol tr) = return ()
+                       writeStructBegin (TBinaryProtocol tr) s = return ()
+                       writeStructEnd (TBinaryProtocol tr) = return ()
+                       writeFieldBegin a (n,t,i) = do writeByte a (fromEnum t)
+                                                      writeI16 a i
+                       writeFieldEnd a = return ()
+                       writeFieldStop a = writeByte a (fromEnum T_STOP)
+                       writeMapBegin a (k,v,s) = do writeByte a (fromEnum k)
+                                                    writeByte a (fromEnum v)
+                                                    writeI32 a s
+                       writeMapEnd a = return ()
+                       writeListBegin a (t,s) = do writeByte a (fromEnum t)
+                                                   writeI32 a s
+                       writeListEnd a = return ()
+                       writeSetBegin = writeListBegin
+                       writeSetEnd a = return ()
+                       readByte (TBinaryProtocol tr) = do b <- treadAll tr 1
+                                                          return $ (fromIntegral (fromIntegral (compBytes b) :: Int8) :: Int)
+                       readI16 (TBinaryProtocol tr) = do b <- treadAll tr 2
+                                                         return $ (fromIntegral (fromIntegral (compBytes b) :: Int16) :: Int)
+                       readI32 (TBinaryProtocol tr) = do b <- treadAll tr 4
+                                                         return $ (fromIntegral (fromIntegral (compBytes b) :: Int32) :: Int)
+                       readI64 (TBinaryProtocol tr) = do b <- treadAll tr 8
+                                                         return $ (fromIntegral (fromIntegral (compBytes64 b) :: Int64) :: Int)
+                       readDouble (TBinaryProtocol tr) = do b <- readI64 (TBinaryProtocol tr)
+                                                            return $ floatOfBits (fromIntegral b :: Word64)
+                       readBool (TBinaryProtocol tr) = do b <- readByte (TBinaryProtocol tr)
+                                                          return $ b == 1
+                       readString (TBinaryProtocol tr) = do l <- readI32 (TBinaryProtocol tr)
+                                                            treadAll tr l
+                       readBinary = readString
+                       readMessageBegin (TBinaryProtocol tr) = do ver <- readI32 (TBinaryProtocol tr)
+                                                                  if (ver .&. version_mask /= version_1) then
+                                                                      throwDyn (ProtocolExn PE_BAD_VERSION "Missing version identifier")
+                                                                      else do
+                                                                        s <- readString (TBinaryProtocol tr)                                                                  
+                                                                        sz <- readI32 (TBinaryProtocol tr)
+                                                                        return (s,toEnum (ver .&. 0xFF) :: Message_type,fromIntegral sz :: Int)
+                       readMessageEnd (TBinaryProtocol tr) = return ()
+                       readStructBegin (TBinaryProtocol tr) = return ""
+                       readStructEnd (TBinaryProtocol tr) = return ()
+                       readFieldBegin (TBinaryProtocol tr) = do t <- readByte (TBinaryProtocol tr)
+                                                                if (toEnum t :: T_type) /= T_STOP then
+                                                                    do s <- readI16 (TBinaryProtocol tr)
+                                                                       return ("",toEnum t :: T_type,fromIntegral s :: Int)
+                                                                    else return ("",toEnum t :: T_type,0)
+                       readFieldEnd (TBinaryProtocol tr) = return ()
+                       readMapBegin a = do kt <- readByte a
+                                           vt <- readByte a
+                                           s <- readI32 a
+                                           return (toEnum kt :: T_type,toEnum vt :: T_type,fromIntegral s :: Int)
+                       readMapEnd a = return ()
+                       readListBegin a = do b <- readByte a
+                                            s <- readI32 a
+                                            return (toEnum b :: T_type,fromIntegral s :: Int)
+                       readListEnd a = return ()
+                       readSetBegin = readListBegin
+                       readSetEnd = readListEnd
+                       pflush (TBinaryProtocol tr) = tflush tr
+
+                                                           
+
diff --git a/lib/hs/src/TChannelTransport.hs b/lib/hs/src/TChannelTransport.hs
new file mode 100644
index 0000000..df1aedc
--- /dev/null
+++ b/lib/hs/src/TChannelTransport.hs
@@ -0,0 +1,22 @@
+module TChannelTransport(TChannelTrans(..)) where
+import System.IO
+import IO
+import Thrift
+import Control.Exception
+data TChannelTrans = TChannelTrans (Handle)
+
+instance TTransport TChannelTrans where
+    tisOpen a = True
+    topen a = return a
+    tclose a = return a
+    tread a 0 = return []
+    tread (TChannelTrans h) i = Prelude.catch 
+                                 (do c <- hGetChar h
+                                     t <- tread (TChannelTrans h) (i-1)
+                                     return $ c:t)
+                                 (\e -> if isEOFError e then return [] else throwDyn (TransportExn "TChannelTransport: Could not read" TE_UNKNOWN))
+    twrite a [] = return ()
+    twrite (TChannelTrans h) (c:t) = do hPutChar h c
+                                        twrite (TChannelTrans h) t
+    tflush (TChannelTrans h) = hFlush h
+
diff --git a/lib/hs/src/TServer.hs b/lib/hs/src/TServer.hs
new file mode 100644
index 0000000..c71882c
--- /dev/null
+++ b/lib/hs/src/TServer.hs
@@ -0,0 +1,29 @@
+module TServer(run_basic_server,run_threaded_server) where
+
+import Network
+import Thrift
+import Control.Exception
+import TBinaryProtocol
+import TChannelTransport
+import Control.Concurrent
+
+proc_loop hand proc ps = do v <-proc hand ps
+                            if v then proc_loop hand proc ps
+                                else return ()
+
+accept_loop hand sock proc transgen iprotgen oprotgen = 
+    do (h,hn,_) <- accept sock
+       let t = transgen h 
+       let ip = iprotgen t
+       let op = oprotgen t
+       forkIO (handle (\e -> return ()) (proc_loop hand proc (ip,op)))
+       accept_loop hand sock proc transgen iprotgen oprotgen
+       
+run_threaded_server hand proc port transgen iprotgen oprotgen = 
+    do sock <- listenOn (PortNumber port)
+       accept_loop hand sock proc transgen iprotgen oprotgen
+       return ()
+       
+
+-- A basic threaded binary protocol socket server.
+run_basic_server hand proc port = run_threaded_server hand proc port TChannelTrans TBinaryProtocol TBinaryProtocol
diff --git a/lib/hs/src/TSocket.hs b/lib/hs/src/TSocket.hs
new file mode 100644
index 0000000..7e72878
--- /dev/null
+++ b/lib/hs/src/TSocket.hs
@@ -0,0 +1,33 @@
+module TSocket(TSocket(..)) where
+import Thrift
+import Data.IORef
+import Network
+import IO
+import Control.Exception
+data TSocket = TSocket{host::[Char],port::PortNumber,chan :: Maybe Handle}
+
+instance TTransport TSocket where
+    tisOpen a = case chan a of
+                  Just _ -> True
+                  Nothing -> False
+    topen a = do h <- connectTo (host a) (PortNumber (port a))
+                 return $ (a{chan = Just h}) 
+    tclose a = case chan a of 
+                 Just h -> do hClose h
+                              return $ a{chan=Nothing}
+                 Nothing -> return a
+    tread a 0 = return []
+    tread a n = case chan a of 
+                  Just h -> handle (\e -> throwDyn (TransportExn "TSocket: Could not read." TE_UNKNOWN))
+                      (do c <- hGetChar h 
+                          l <- tread a (n-1)
+                          return $ c:l)
+                  Nothing -> return []
+    twrite a s = case chan a of
+                   Just h -> hPutStr h s
+                   Nothing -> return ()
+    tflush a = case chan a of
+                 Just h -> hFlush h
+                 Nothing -> return ()
+
+
diff --git a/lib/hs/src/Thrift.hs b/lib/hs/src/Thrift.hs
new file mode 100644
index 0000000..4087b2b
--- /dev/null
+++ b/lib/hs/src/Thrift.hs
@@ -0,0 +1,298 @@
+module Thrift (TransportExn(..),TransportExn_Type(..),TTransport(..), T_type(..), Message_type(..), Protocol(..), AE_type(..), AppExn(..), readAppExn,writeAppExn,Thrift_exception(..), ProtocolExn(..), PE_type(..)) where
+  import Data.Generics
+  import Data.Int
+  import Control.Exception
+
+  data Thrift_exception = Thrift_Error deriving Typeable
+
+  data TransportExn_Type = TE_UNKNOWN
+                          | TE_NOT_OPEN
+                          | TE_ALREADY_OPEN
+                          | TE_TIMED_OUT
+                          | TE_END_OF_FILE
+                            deriving (Eq,Typeable,Show)
+
+  data TransportExn = TransportExn [Char] TransportExn_Type  deriving (Show,Typeable)
+
+  class TTransport a where
+      tisOpen :: a -> Bool
+      topen :: a -> IO a
+      tclose :: a -> IO a
+      tread :: a  -> Int -> IO [Char]
+      twrite :: a -> [Char] ->IO ()
+      tflush :: a -> IO ()
+      treadAll :: a -> Int -> IO [Char]
+      treadAll a 0 = return []
+      treadAll a len =
+          do ret <- tread a len
+             case ret of
+               [] -> throwDyn (TransportExn "Cannot read. Remote side has closed." TE_UNKNOWN)
+               _ -> do
+                   rl <- return (length ret)
+                   if len <= rl then
+                       return ret
+                       else do r <- treadAll a (len-rl)
+                               return (ret++r)
+            
+  
+  data T_type = T_STOP 
+              | T_VOID     
+              | T_BOOL
+              | T_BYTE
+              | T_I08 
+              | T_I16 
+              | T_I32 
+              | T_U64 
+              | T_I64 
+              | T_DOUBLE 
+              | T_STRING 
+              | T_UTF7   
+              | T_STRUCT    
+              | T_MAP       
+              | T_SET       
+              | T_LIST      
+              | T_UTF8      
+              | T_UTF16
+              | T_UNKNOWN
+                deriving (Eq)
+  instance Enum T_type where
+      fromEnum t = case t of
+                     T_STOP       -> 0
+                     T_VOID       -> 1
+                     T_BOOL       -> 2
+                     T_BYTE       -> 3
+                     T_I08        -> 3
+                     T_I16        -> 6
+                     T_I32        -> 8
+                     T_U64        -> 9
+                     T_I64        -> 10
+                     T_DOUBLE     -> 4
+                     T_STRING     -> 11
+                     T_UTF7       -> 11
+                     T_STRUCT     -> 12
+                     T_MAP        -> 13
+                     T_SET        -> 14
+                     T_LIST       -> 15
+                     T_UTF8       -> 16
+                     T_UTF16      -> 17
+                     T_UNKNOWN    -> -1                       
+      toEnum t = case t of 
+                   0 -> T_STOP      
+                   1 -> T_VOID      
+                   2 -> T_BOOL
+                   3 -> T_BYTE
+                   6->  T_I16       
+                   8 -> T_I32      
+                   9 -> T_U64      
+                   10 -> T_I64     
+                   4 -> T_DOUBLE   
+                   11 -> T_STRING
+                   12 -> T_STRUCT
+                   13 -> T_MAP   
+                   14 -> T_SET   
+                   15 -> T_LIST  
+                   16 -> T_UTF8  
+                   17 -> T_UTF16
+                   _ -> T_UNKNOWN
+  
+  
+  data Message_type = M_CALL
+                    | M_REPLY
+                    | M_EXCEPTION
+                    | M_UNKNOWN
+                      deriving Eq
+  instance Enum Message_type where
+                      
+      fromEnum t = case t of
+                     M_CALL -> 1
+                     M_REPLY -> 2
+                     M_EXCEPTION -> 3
+                     M_UNKNOWN -> -1
+                          
+      toEnum t = case t of
+                   1 -> M_CALL
+                   2 -> M_REPLY
+                   3 -> M_EXCEPTION
+                   _ -> M_UNKNOWN
+  
+  
+  
+  
+  class Protocol a where
+      pflush ::  a -> IO ()
+      writeMessageBegin :: a -> ([Char],Message_type,Int) -> IO ()
+      writeMessageEnd :: a -> IO ()
+      writeStructBegin :: a -> [Char] -> IO ()
+      writeStructEnd :: a -> IO ()
+      writeFieldBegin :: a -> ([Char], T_type,Int) -> IO ()
+      writeFieldEnd :: a -> IO ()
+      writeFieldStop :: a -> IO ()
+      writeMapBegin :: a -> (T_type,T_type,Int) -> IO ()
+      writeMapEnd :: a -> IO ()
+      writeListBegin :: a -> (T_type,Int) -> IO ()
+      writeListEnd :: a -> IO ()
+      writeSetBegin :: a -> (T_type,Int) -> IO ()
+      writeSetEnd :: a -> IO ()
+      writeBool :: a -> Bool -> IO ()
+      writeByte :: a -> Int -> IO ()
+      writeI16 :: a -> Int -> IO ()
+      writeI32 :: a -> Int -> IO ()
+      writeI64 :: a -> Int -> IO ()
+      writeDouble :: a -> Double -> IO ()
+      writeString :: a -> [Char] -> IO ()
+      writeBinary :: a -> [Char] -> IO ()
+      readMessageBegin :: a -> IO ([Char],Message_type,Int)
+      readMessageEnd :: a -> IO ()
+      readStructBegin :: a -> IO [Char]
+      readStructEnd :: a -> IO ()
+      readFieldBegin :: a -> IO ([Char],T_type,Int)
+      readFieldEnd :: a -> IO ()
+      readMapBegin :: a -> IO (T_type,T_type,Int)
+      readMapEnd :: a -> IO ()
+      readListBegin :: a -> IO (T_type,Int)
+      readListEnd :: a -> IO ()
+      readSetBegin :: a -> IO (T_type,Int)
+      readSetEnd :: a -> IO ()
+      readBool :: a -> IO Bool
+      readByte :: a -> IO Int
+      readI16 :: a -> IO Int
+      readI32 :: a -> IO Int
+      readI64 :: a -> IO Int
+      readDouble :: a -> IO Double
+      readString :: a -> IO [Char]
+      readBinary :: a -> IO [Char]
+      skipFields :: a -> IO ()
+      skipMapEntries :: a -> Int -> T_type -> T_type -> IO ()
+      skipSetEntries :: a -> Int -> T_type -> IO ()
+      skip :: a -> T_type -> IO ()
+      skipFields a = do (_,ty,_) <- readFieldBegin a
+                        if ty == T_STOP then
+                              return ()
+                              else do skip a ty
+                                      readFieldEnd a
+                                      skipFields a
+      skipMapEntries a n k v= if n == 0 then
+                                    return ()
+                                    else do skip a k
+                                            skip a v
+                                            skipMapEntries a (n-1) k v
+      skipSetEntries a n k = if n == 0 then
+                                   return ()
+                                   else do skip a k
+                                           skipSetEntries a (n-1) k
+      skip a typ = case typ of
+                       T_STOP -> return ()
+                       T_VOID -> return ()
+                       T_BOOL -> do readBool a
+                                    return ()
+                       T_BYTE -> do readByte a
+                                    return ()
+                       T_I08 -> do readByte a
+                                   return ()
+                       T_I16 -> do readI16 a
+                                   return ()
+                       T_I32 -> do readI32 a
+                                   return ()
+                       T_U64 -> do readI64 a
+                                   return ()
+                       T_I64 -> do readI64 a
+                                   return ()
+                       T_DOUBLE -> do readDouble a
+                                      return ()
+                       T_STRING -> do readString a
+                                      return ()
+                       T_UTF7 -> return ()
+                       T_STRUCT -> do readStructBegin a
+                                      skipFields a
+                                      readStructEnd a
+                                      return ()
+                       T_MAP -> do (k,v,s) <- readMapBegin a
+                                   skipMapEntries a s k v
+                                   readMapEnd a
+                                   return ()
+                       T_SET -> do (ty,s) <- readSetBegin a
+                                   skipSetEntries a s ty
+                                   readSetEnd a
+                                   return ()
+                       T_LIST -> do (ty,s) <- readListBegin a
+                                    skipSetEntries a s ty
+                                    readListEnd a
+                                    return ()
+                       T_UTF8       -> return ()
+                       T_UTF16      -> return ()
+                       T_UNKNOWN    -> return ()
+  
+  
+  data PE_type = PE_UNKNOWN      
+               | PE_INVALID_DATA
+               | PE_NEGATIVE_SIZE
+               | PE_SIZE_LIMIT
+               | PE_BAD_VERSION
+                 deriving (Eq, Data, Typeable)
+
+  data ProtocolExn = ProtocolExn PE_type [Char] deriving (Typeable, Data)
+  
+  data AE_type = AE_UNKNOWN
+               | AE_UNKNOWN_METHOD
+               | AE_INVALID_MESSAGE_TYPE
+               | AE_WRONG_METHOD_NAME
+               | AE_BAD_SEQUENCE_ID
+               | AE_MISSING_RESULT
+                 deriving (Eq, Data, Typeable)
+  
+  instance Enum AE_type where
+      toEnum i = case i of
+                   0 -> AE_UNKNOWN
+                   1 -> AE_UNKNOWN_METHOD
+                   2 -> AE_INVALID_MESSAGE_TYPE
+                   3 -> AE_WRONG_METHOD_NAME
+                   4 -> AE_BAD_SEQUENCE_ID
+                   5 -> AE_MISSING_RESULT
+                   _ -> AE_UNKNOWN
+      fromEnum t = case t of
+                     AE_UNKNOWN -> 0
+                     AE_UNKNOWN_METHOD -> 1
+                     AE_INVALID_MESSAGE_TYPE -> 2
+                     AE_WRONG_METHOD_NAME -> 3
+                     AE_BAD_SEQUENCE_ID -> 4
+                     AE_MISSING_RESULT -> 5
+  
+  data AppExn = AppExn {ae_type :: AE_type, ae_message :: [Char]} deriving (Typeable, Data)
+  
+  readAppExnFields pt rec = do (n,ft,id) <- readFieldBegin pt
+                               if ft == T_STOP then return rec
+                                      else
+                                        case id of
+                                          1 -> if ft == T_STRING then
+                                                   do s <- readString pt
+                                                      readAppExnFields pt rec{ae_message = s}
+                                                   else do skip pt ft
+                                                           readAppExnFields pt rec
+                                          2 -> if ft == T_I32 then
+                                                   do i <- readI32 pt
+                                                      readAppExnFields pt rec{ae_type = (toEnum  i)}
+                                                   else do skip pt ft
+                                                           readAppExnFields pt rec
+                                          _ -> do skip pt ft
+                                                  readFieldEnd pt
+                                                  readAppExnFields pt rec
+  
+  readAppExn pt = do readStructBegin pt
+                     rec <- readAppExnFields pt (AppExn {ae_type = undefined, ae_message = undefined})
+                     readStructEnd pt
+                     return rec
+  
+  
+  writeAppExn pt ae = do writeStructBegin pt "TApplicationException"
+                         if ae_message ae /= "" then
+                             do writeFieldBegin pt ("message",T_STRING,1)
+                                writeString pt (ae_message ae)
+                                writeFieldEnd pt
+                             else return ()
+                         writeFieldBegin pt ("type",T_I32,2);
+                         writeI32 pt (fromEnum (ae_type ae))
+                         writeFieldEnd pt
+                         writeFieldStop pt
+                         writeStructEnd pt
+
+