thrift-commits mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From bryanduxb...@apache.org
Subject svn commit: r763031 - in /incubator/thrift/trunk: compiler/cpp/src/generate/ lib/hs/ lib/hs/src/ lib/hs/src/Thrift/ lib/hs/src/Thrift/Protocol/ lib/hs/src/Thrift/Transport/ test/hs/
Date Tue, 07 Apr 2009 23:29:43 GMT
Author: bryanduxbury
Date: Tue Apr  7 23:29:42 2009
New Revision: 763031

URL: http://svn.apache.org/viewvc?rev=763031&view=rev
Log:
THRIFT-407. hs: Refactor and improve Haskell-related code


Added:
    incubator/thrift/trunk/lib/hs/src/Thrift/
    incubator/thrift/trunk/lib/hs/src/Thrift/Protocol/
    incubator/thrift/trunk/lib/hs/src/Thrift/Protocol.hs
    incubator/thrift/trunk/lib/hs/src/Thrift/Protocol/Binary.hs
    incubator/thrift/trunk/lib/hs/src/Thrift/Server.hs
    incubator/thrift/trunk/lib/hs/src/Thrift/Transport/
    incubator/thrift/trunk/lib/hs/src/Thrift/Transport.hs
    incubator/thrift/trunk/lib/hs/src/Thrift/Transport/Handle.hs
Removed:
    incubator/thrift/trunk/lib/hs/src/TBinaryProtocol.hs
    incubator/thrift/trunk/lib/hs/src/TChannelTransport.hs
    incubator/thrift/trunk/lib/hs/src/TServer.hs
    incubator/thrift/trunk/lib/hs/src/TSocket.hs
Modified:
    incubator/thrift/trunk/compiler/cpp/src/generate/t_hs_generator.cc
    incubator/thrift/trunk/lib/hs/Thrift.cabal
    incubator/thrift/trunk/lib/hs/src/Thrift.hs
    incubator/thrift/trunk/test/hs/Client.hs
    incubator/thrift/trunk/test/hs/Server.hs
    incubator/thrift/trunk/test/hs/runclient.sh
    incubator/thrift/trunk/test/hs/runserver.sh

Modified: incubator/thrift/trunk/compiler/cpp/src/generate/t_hs_generator.cc
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/compiler/cpp/src/generate/t_hs_generator.cc?rev=763031&r1=763030&r2=763031&view=diff
==============================================================================
--- incubator/thrift/trunk/compiler/cpp/src/generate/t_hs_generator.cc (original)
+++ incubator/thrift/trunk/compiler/cpp/src/generate/t_hs_generator.cc Tue Apr  7 23:29:42
2009
@@ -211,7 +211,7 @@
  * Prints standard thrift imports
  */
 string t_hs_generator::hs_imports() {
-  return "import Thrift\nimport Data.Generics\nimport Control.Exception\nimport qualified
Data.Map as Map\nimport qualified Data.Set as Set\nimport Data.Int";
+  return "import Thrift\nimport Data.Typeable ( Typeable )\nimport Control.Exception\nimport
qualified Data.Map as Map\nimport qualified Data.Set as Set\nimport Data.Int";
 }
 
 /**
@@ -253,7 +253,7 @@
       f_types_ << "|";
     f_types_ << name;
   }
-  indent(f_types_) << "deriving (Show,Eq, Typeable, Data, Ord)" << endl;
+  indent(f_types_) << "deriving (Show,Eq, Typeable, Ord)" << endl;
   indent_down();
 
   int value = -1;
@@ -287,7 +287,7 @@
     f_types_ <<
       indent() << value << " -> " << name << endl;
   }
-  indent(f_types_) << "_ -> throwDyn Thrift_Error" << endl;
+  indent(f_types_) << "_ -> throw ThriftException" << endl;
   indent_down();
   indent_down();
 }
@@ -487,7 +487,7 @@
   }
 
   out << " deriving (Show,Eq,Ord,Typeable)" << endl;
-
+  if (is_exception) out << "instance Exception " << tname << endl;
   generate_hs_struct_writer(out, tstruct);
 
   generate_hs_struct_reader(out, tstruct);
@@ -810,7 +810,7 @@
     // Write to the stream
     f_client_ <<
       indent() << "writeMessageEnd op" << endl <<
-      indent() << "tflush (getTransport op)" << endl;
+      indent() << "tFlush (getTransport op)" << endl;
 
     indent_down();
 
@@ -837,7 +837,7 @@
         indent() << "  x <- readAppExn ip" << endl <<
         indent() << "  readMessageEnd ip" << endl;
       f_client_ <<
-        indent() << "  throwDyn x" << endl;
+        indent() << "  throw x" << endl;
       f_client_ <<
         indent() << "  else return ()" << endl;
 
@@ -866,7 +866,7 @@
           indent() << "case f_"<< resultname << "_" << (*x_iter)->get_name()
<< " res of" << endl;
         indent_up(); //case
         indent(f_client_) << "Nothing -> return ()" << endl;
-        indent(f_client_) << "Just _v -> throwDyn _v" << endl;
+        indent(f_client_) << "Just _v -> throw _v" << endl;
         indent_down(); //-case
       }
 
@@ -876,7 +876,7 @@
           "return ()" << endl;
       } else {
         f_client_ <<
-          indent() << "throwDyn (AppExn AE_MISSING_RESULT \"" << (*f_iter)->get_name()
<< " failed: unknown result\")" << endl;
+          indent() << "throw (AppExn AE_MISSING_RESULT \"" << (*f_iter)->get_name()
<< " failed: unknown result\")" << endl;
         indent_down(); //-none
         indent_down(); //-case
       }
@@ -923,7 +923,7 @@
     indent(f_service_) << "writeMessageBegin oprot (name,M_EXCEPTION,seqid)" <<
endl;
     indent(f_service_) << "writeAppExn oprot (AppExn AE_UNKNOWN_METHOD (\"Unknown function
\" ++ name))" << endl;
     indent(f_service_) << "writeMessageEnd oprot" << endl;
-    indent(f_service_) << "tflush (getTransport oprot)" << endl;
+    indent(f_service_) << "tFlush (getTransport oprot)" << endl;
     indent_down();
   }
   indent_down();
@@ -987,7 +987,7 @@
   // Try block for a function with exceptions
   if (xceptions.size() > 0) {
     for(unsigned int i=0;i<xceptions.size();i++){
-      f_service_ << "(catchDyn" << endl;
+      f_service_ << "(Control.Exception.catch" << endl;
       indent_up();
       f_service_ << indent();
     }
@@ -1045,7 +1045,7 @@
     indent() << "writeMessageBegin oprot (\"" << tfunction->get_name() <<
"\", M_REPLY, seqid);" << endl <<
     indent() << "write_"<<resultname<<" oprot res" << endl <<
     indent() << "writeMessageEnd oprot" << endl <<
-    indent() << "tflush (getTransport oprot)" << endl;
+    indent() << "tFlush (getTransport oprot)" << endl;
 
   // Close function
   indent_down();

Modified: incubator/thrift/trunk/lib/hs/Thrift.cabal
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/lib/hs/Thrift.cabal?rev=763031&r1=763030&r2=763031&view=diff
==============================================================================
--- incubator/thrift/trunk/lib/hs/Thrift.cabal (original)
+++ incubator/thrift/trunk/lib/hs/Thrift.cabal Tue Apr  7 23:29:42 2009
@@ -1,6 +1,7 @@
 Name:           Thrift
 Version:        0.1.0
 Cabal-Version:  >= 1.2
+License:        Apache2
 Category:       Foreign
 Build-Type:     Simple
 Synopsis:       Thrift library package
@@ -9,10 +10,11 @@
   Hs-Source-Dirs:
     src
   Build-Depends:
-    base <4 && >2, network, ghc-prim
+    base >=4, network, ghc-prim
   ghc-options:
     -fglasgow-exts
   Extensions:
     DeriveDataTypeable
   Exposed-Modules:
-    Thrift, TBinaryProtocol, TChannelTransport, TServer, TSocket
+    Thrift, Thrift.Protocol, Thrift.Transport, Thrift.Protocol.Binary
+    Thrift.Transport.Handle, Thrift.Server

Modified: incubator/thrift/trunk/lib/hs/src/Thrift.hs
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/lib/hs/src/Thrift.hs?rev=763031&r1=763030&r2=763031&view=diff
==============================================================================
--- incubator/thrift/trunk/lib/hs/src/Thrift.hs (original)
+++ incubator/thrift/trunk/lib/hs/src/Thrift.hs Tue Apr  7 23:29:42 2009
@@ -17,304 +17,95 @@
 -- under the License.
 --
 
-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_ONEWAY
-                    | M_UNKNOWN
-                      deriving Eq
-  instance Enum Message_type where
-
-      fromEnum t = case t of
-                     M_CALL -> 1
-                     M_REPLY -> 2
-                     M_EXCEPTION -> 3
-                     M_ONEWAY -> 4
-                     M_UNKNOWN -> -1
-
-      toEnum t = case t of
-                   1 -> M_CALL
-                   2 -> M_REPLY
-                   3 -> M_EXCEPTION
-                   4 -> M_ONEWAY
-                   _ -> M_UNKNOWN
-
-
-
-
-  class Protocol a where
-      getTransport :: TTransport t => a t -> t
-      writeMessageBegin :: TTransport t => a t -> ([Char],Message_type,Int) -> IO
()
-      writeMessageEnd :: TTransport t => a t -> IO ()
-      writeStructBegin :: TTransport t => a t -> [Char] -> IO ()
-      writeStructEnd :: TTransport t => a t -> IO ()
-      writeFieldBegin :: TTransport t => a t -> ([Char], T_type,Int) -> IO ()
-      writeFieldEnd :: TTransport t => a t -> IO ()
-      writeFieldStop :: TTransport t => a t -> IO ()
-      writeMapBegin :: TTransport t => a t -> (T_type,T_type,Int) -> IO ()
-      writeMapEnd :: TTransport t => a t -> IO ()
-      writeListBegin :: TTransport t => a t -> (T_type,Int) -> IO ()
-      writeListEnd :: TTransport t => a t -> IO ()
-      writeSetBegin :: TTransport t => a t -> (T_type,Int) -> IO ()
-      writeSetEnd :: TTransport t => a t -> IO ()
-      writeBool :: TTransport t => a t -> Bool -> IO ()
-      writeByte :: TTransport t => a t -> Int -> IO ()
-      writeI16 :: TTransport t => a t -> Int -> IO ()
-      writeI32 :: TTransport t => a t -> Int -> IO ()
-      writeI64 :: TTransport t => a t -> Int64 -> IO ()
-      writeDouble :: TTransport t => a t -> Double -> IO ()
-      writeString :: TTransport t => a t -> [Char] -> IO ()
-      writeBinary :: TTransport t => a t -> [Char] -> IO ()
-      readMessageBegin :: TTransport t => a t -> IO ([Char],Message_type,Int)
-      readMessageEnd :: TTransport t => a t -> IO ()
-      readStructBegin :: TTransport t => a t -> IO [Char]
-      readStructEnd :: TTransport t => a t -> IO ()
-      readFieldBegin :: TTransport t => a t -> IO ([Char],T_type,Int)
-      readFieldEnd :: TTransport t => a t -> IO ()
-      readMapBegin :: TTransport t => a t -> IO (T_type,T_type,Int)
-      readMapEnd :: TTransport t => a t -> IO ()
-      readListBegin :: TTransport t => a t -> IO (T_type,Int)
-      readListEnd :: TTransport t => a t -> IO ()
-      readSetBegin :: TTransport t => a t -> IO (T_type,Int)
-      readSetEnd :: TTransport t => a t -> IO ()
-      readBool :: TTransport t => a t -> IO Bool
-      readByte :: TTransport t => a t -> IO Int
-      readI16 :: TTransport t => a t -> IO Int
-      readI32 :: TTransport t => a t -> IO Int
-      readI64 :: TTransport t => a t -> IO Int64
-      readDouble :: TTransport t => a t -> IO Double
-      readString :: TTransport t => a t -> IO [Char]
-      readBinary :: TTransport t => a t -> IO [Char]
-      skipFields :: TTransport t => a t -> IO ()
-      skipMapEntries :: TTransport t => a t -> Int -> T_type -> T_type ->
IO ()
-      skipSetEntries :: TTransport t => a t -> Int -> T_type -> IO ()
-      skip :: TTransport t => a t -> 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
-
+module Thrift
+    ( module Thrift.Transport
+    , module Thrift.Protocol
+    , AppExnType(..)
+    , AppExn(..)
+    , readAppExn
+    , writeAppExn
+    , ThriftException(..)
+    ) where
+
+import Control.Monad ( when )
+import Control.Exception
+
+import Data.Typeable ( Typeable )
+
+import Thrift.Transport
+import Thrift.Protocol
+
+
+data ThriftException = ThriftException
+  deriving ( Show, Typeable )
+instance Exception ThriftException
+
+data AppExnType
+    = AE_UNKNOWN
+    | AE_UNKNOWN_METHOD
+    | AE_INVALID_MESSAGE_TYPE
+    | AE_WRONG_METHOD_NAME
+    | AE_BAD_SEQUENCE_ID
+    | AE_MISSING_RESULT
+      deriving ( Eq, Show, Typeable )
+
+instance Enum AppExnType where
+    toEnum 0 = AE_UNKNOWN
+    toEnum 1 = AE_UNKNOWN_METHOD
+    toEnum 2 = AE_INVALID_MESSAGE_TYPE
+    toEnum 3 = AE_WRONG_METHOD_NAME
+    toEnum 4 = AE_BAD_SEQUENCE_ID
+    toEnum 5 = AE_MISSING_RESULT
+
+    fromEnum AE_UNKNOWN = 0
+    fromEnum AE_UNKNOWN_METHOD = 1
+    fromEnum AE_INVALID_MESSAGE_TYPE = 2
+    fromEnum AE_WRONG_METHOD_NAME = 3
+    fromEnum AE_BAD_SEQUENCE_ID = 4
+    fromEnum AE_MISSING_RESULT = 5
+
+data AppExn = AppExn { ae_type :: AppExnType, ae_message :: String }
+  deriving ( Show, Typeable )
+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 (ae_message ae)
+        writeFieldEnd pt
+
+    writeFieldBegin pt ("type", T_I32, 2);
+    writeI32 pt (fromEnum (ae_type ae))
+    writeFieldEnd pt
+    writeFieldStop pt
+    writeStructEnd pt
+
+readAppExn :: (Protocol p, Transport t) => p t -> IO AppExn
+readAppExn pt = do
+    readStructBegin pt
+    rec <- readAppExnFields pt (AppExn {ae_type = undefined, ae_message = undefined})
+    readStructEnd pt
+    return rec
+
+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
 

Added: incubator/thrift/trunk/lib/hs/src/Thrift/Protocol.hs
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/lib/hs/src/Thrift/Protocol.hs?rev=763031&view=auto
==============================================================================
--- incubator/thrift/trunk/lib/hs/src/Thrift/Protocol.hs (added)
+++ incubator/thrift/trunk/lib/hs/src/Thrift/Protocol.hs Tue Apr  7 23:29:42 2009
@@ -0,0 +1,191 @@
+--
+-- 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.Protocol
+    ( Protocol(..)
+    , skip
+    , MessageType(..)
+    , ThriftType(..)
+    , ProtocolExn(..)
+    , ProtocolExnType(..)
+    ) where
+
+import Control.Monad ( replicateM_, unless )
+import Control.Exception
+
+import Data.Typeable ( Typeable )
+import Data.Int
+
+import Thrift.Transport
+
+
+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
+
+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
+
+
+class Protocol a where
+    getTransport :: Transport t => a t -> t
+
+    writeMessageBegin :: Transport t => a t -> (String, MessageType, Int) -> IO
()
+    writeMessageEnd   :: Transport t => a t -> IO ()
+
+    writeStructBegin :: Transport t => a t -> String -> IO ()
+    writeStructEnd   :: Transport t => a t -> IO ()
+    writeFieldBegin  :: Transport t => a t -> (String, ThriftType, Int) -> IO ()
+    writeFieldEnd    :: Transport t => a t -> IO ()
+    writeFieldStop   :: Transport t => a t -> IO ()
+    writeMapBegin    :: Transport t => a t -> (ThriftType, ThriftType, Int) -> IO
()
+    writeMapEnd      :: Transport t => a t -> IO ()
+    writeListBegin   :: Transport t => a t -> (ThriftType, Int) -> IO ()
+    writeListEnd     :: Transport t => a t -> IO ()
+    writeSetBegin    :: Transport t => a t -> (ThriftType, Int) -> IO ()
+    writeSetEnd      :: Transport t => a t -> IO ()
+
+    writeBool   :: Transport t => a t -> Bool -> IO ()
+    writeByte   :: Transport t => a t -> Int -> IO ()
+    writeI16    :: Transport t => a t -> Int -> IO ()
+    writeI32    :: Transport t => a t -> Int -> IO ()
+    writeI64    :: Transport t => a t -> Int64 -> IO ()
+    writeDouble :: Transport t => a t -> Double -> IO ()
+    writeString :: Transport t => a t -> String -> IO ()
+    writeBinary :: Transport t => a t -> String -> IO ()
+
+
+    readMessageBegin :: Transport t => a t -> IO (String, MessageType, Int)
+    readMessageEnd   :: Transport t => a t -> IO ()
+
+    readStructBegin :: Transport t => a t -> IO String
+    readStructEnd   :: Transport t => a t -> IO ()
+    readFieldBegin  :: Transport t => a t -> IO (String, ThriftType, Int)
+    readFieldEnd    :: Transport t => a t -> IO ()
+    readMapBegin    :: Transport t => a t -> IO (ThriftType, ThriftType, Int)
+    readMapEnd      :: Transport t => a t -> IO ()
+    readListBegin   :: Transport t => a t -> IO (ThriftType, Int)
+    readListEnd     :: Transport t => a t -> IO ()
+    readSetBegin    :: Transport t => a t -> IO (ThriftType, Int)
+    readSetEnd      :: Transport t => a t -> IO ()
+
+    readBool   :: Transport t => a t -> IO Bool
+    readByte   :: Transport t => a t -> IO Int
+    readI16    :: Transport t => a t -> IO Int
+    readI32    :: Transport t => a t -> IO Int
+    readI64    :: Transport t => a t -> IO Int64
+    readDouble :: Transport t => a t -> IO Double
+    readString :: Transport t => a t -> IO String
+    readBinary :: Transport t => a t -> IO String
+
+
+skip :: (Protocol p, Transport t) => p t -> ThriftType -> IO ()
+skip p T_STOP = return ()
+skip p 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_ s (skip p k >> skip p v)
+                  readMapEnd p
+skip p T_SET = do (t, n) <- readSetBegin p
+                  replicateM_ n (skip p t)
+                  readSetEnd p
+skip p T_LIST = do (t, n) <- readListBegin p
+                   replicateM_ 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)
+
+
+data ProtocolExnType
+    = PE_UNKNOWN
+    | PE_INVALID_DATA
+    | PE_NEGATIVE_SIZE
+    | PE_SIZE_LIMIT
+    | PE_BAD_VERSION
+      deriving ( Eq, Show, Typeable )
+
+data ProtocolExn = ProtocolExn ProtocolExnType String
+  deriving ( Show, Typeable )
+instance Exception ProtocolExn

Added: incubator/thrift/trunk/lib/hs/src/Thrift/Protocol/Binary.hs
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/lib/hs/src/Thrift/Protocol/Binary.hs?rev=763031&view=auto
==============================================================================
--- incubator/thrift/trunk/lib/hs/src/Thrift/Protocol/Binary.hs (added)
+++ incubator/thrift/trunk/lib/hs/src/Thrift/Protocol/Binary.hs Tue Apr  7 23:29:42 2009
@@ -0,0 +1,147 @@
+--
+-- 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.Protocol.Binary
+    ( module Thrift.Protocol
+    , BinaryProtocol(..)
+    ) where
+
+import Control.Exception ( throw )
+
+import Data.Bits
+import Data.Int
+import Data.List ( foldl' )
+
+import GHC.Exts
+import GHC.Word
+
+import Thrift.Protocol
+import Thrift.Transport
+
+
+version_mask = 0xffff0000
+version_1    = 0x80010000
+
+data BinaryProtocol a = Transport a => BinaryProtocol a
+
+
+instance Protocol BinaryProtocol where
+    getTransport (BinaryProtocol t) = t
+
+    writeMessageBegin p (n, t, s) = do
+        writeI32 p (version_1 .|. (fromEnum t))
+        writeString p n
+        writeI32 p s
+    writeMessageEnd _ = return ()
+
+    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 p = 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 ()
+
+    writeBool p b = tWrite (getTransport p) [toEnum $ if b then 1 else 0]
+    writeByte p b = tWrite (getTransport p) (getBytes b 1)
+    writeI16 p b = tWrite (getTransport p) (getBytes b 2)
+    writeI32 p b = tWrite (getTransport p) (getBytes b 4)
+    writeI64 p b = tWrite (getTransport p) (getBytes b 8)
+    writeDouble p d = writeI64 p (fromIntegral $ floatBits d)
+    writeString p s = writeI32 p (length s) >> tWrite (getTransport p) s
+    writeBinary = writeString
+
+    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 $ 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 ()
+
+    readBool p = (== 1) `fmap` readByte p
+    readByte p = do
+        bs <- tReadAll (getTransport p) 1
+        return $ fromIntegral (composeBytes bs :: Int8)
+    readI16 p = do
+        bs <- tReadAll (getTransport p) 2
+        return $ fromIntegral (composeBytes bs :: Int16)
+    readI32 p = composeBytes `fmap` tReadAll (getTransport p) 4
+    readI64 p = composeBytes `fmap` tReadAll (getTransport p) 8
+    readDouble p = do
+        bs <- readI64 p
+        return $ floatOfBits $ fromIntegral bs
+    readString p = readI32 p >>= tReadAll (getTransport p)
+    readBinary = readString
+
+
+-- | Write a type as a byte
+writeType :: (Protocol p, Transport t) => p t -> ThriftType -> IO ()
+writeType p t = writeByte p (fromEnum t)
+
+-- | Read a byte as though it were a ThriftType
+readType :: (Protocol p, Transport t) => p t -> IO ThriftType
+readType p = toEnum `fmap` readByte p
+
+composeBytes :: (Bits b, Enum t) => [t] -> b
+composeBytes = (foldl' fn 0) . (map $ fromIntegral . fromEnum)
+    where fn acc b = (acc `shiftL` 8) .|. b
+
+getByte :: Bits a => a -> Int -> a
+getByte i n = 255 .&. (i `shiftR` (8 * n))
+
+getBytes :: (Bits a, Integral a) => a -> Int -> String
+getBytes i 0 = []
+getBytes i n = (toEnum $ fromIntegral $ getByte i (n-1)):(getBytes i (n-1))
+
+floatBits :: Double -> Word64
+floatBits (D# d#) = W64# (unsafeCoerce# d#)
+
+floatOfBits :: Word64 -> Double
+floatOfBits (W64# b#) = D# (unsafeCoerce# b#)
+

Added: incubator/thrift/trunk/lib/hs/src/Thrift/Server.hs
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/lib/hs/src/Thrift/Server.hs?rev=763031&view=auto
==============================================================================
--- incubator/thrift/trunk/lib/hs/src/Thrift/Server.hs (added)
+++ incubator/thrift/trunk/lib/hs/src/Thrift/Server.hs Tue Apr  7 23:29:42 2009
@@ -0,0 +1,65 @@
+--
+-- 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.Server
+    ( runBasicServer
+    , runThreadedServer
+    ) where
+
+import Control.Concurrent ( forkIO )
+import Control.Exception
+import Control.Monad ( forever, when )
+
+import Network
+
+import System.IO
+
+import Thrift
+import Thrift.Transport.Handle
+import Thrift.Protocol.Binary
+
+
+-- | A threaded sever that is capable of using any Transport or Protocol
+-- instances.
+runThreadedServer :: (Transport t, Protocol i, Protocol o)
+                  => (Socket -> IO (i t, o t))
+                  -> h
+                  -> (h -> (i t, o t) -> IO Bool)
+                  -> PortID
+                  -> IO a
+runThreadedServer accepter hand proc port = do
+    socket <- listenOn port
+    acceptLoop (accepter socket) (proc hand)
+
+-- | A basic threaded binary protocol socket server.
+runBasicServer :: h
+               -> (h -> (BinaryProtocol Handle, BinaryProtocol Handle) -> IO Bool)
+               -> PortNumber
+               -> IO a
+runBasicServer hand proc port = runThreadedServer binaryAccept hand proc (PortNumber port)
+  where binaryAccept s = do
+            (h, _, _) <- accept s
+            return (BinaryProtocol h, BinaryProtocol h)
+
+acceptLoop :: IO t -> (t -> IO Bool) -> IO a
+acceptLoop accepter proc = forever $
+    do ps <- accepter
+       forkIO $ handle (\(e :: SomeException) -> return ())
+                  (loop $ proc ps)
+  where loop m = do { continue <- m; when continue (loop m) }

Added: incubator/thrift/trunk/lib/hs/src/Thrift/Transport.hs
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/lib/hs/src/Thrift/Transport.hs?rev=763031&view=auto
==============================================================================
--- incubator/thrift/trunk/lib/hs/src/Thrift/Transport.hs (added)
+++ incubator/thrift/trunk/lib/hs/src/Thrift/Transport.hs Tue Apr  7 23:29:42 2009
@@ -0,0 +1,60 @@
+--
+-- 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
+  ( Transport(..)
+  , TransportExn(..)
+  , TransportExnType(..)
+  ) where
+
+import Control.Monad ( when )
+import Control.Exception ( Exception, throw )
+
+import Data.Typeable ( Typeable )
+
+
+class Transport a where
+    tIsOpen :: a -> IO Bool
+    tClose  :: a -> IO ()
+    tRead   :: a -> Int -> IO String
+    tWrite  :: a -> String ->IO ()
+    tFlush  :: a -> IO ()
+    tReadAll :: a -> Int -> IO String
+
+    tReadAll a 0 = return []
+    tReadAll a len = do
+        result <- tRead a len
+        let rlen = length result
+        when (rlen == 0) (throw $ TransportExn "Cannot read. Remote side has closed." TE_UNKNOWN)
+        if len <= rlen
+            then return result
+            else (result ++) `fmap` (tReadAll a (len - rlen))
+
+data TransportExn = TransportExn String TransportExnType
+  deriving ( Show, Typeable )
+instance Exception TransportExn
+
+data TransportExnType
+    = TE_UNKNOWN
+    | TE_NOT_OPEN
+    | TE_ALREADY_OPEN
+    | TE_TIMED_OUT
+    | TE_END_OF_FILE
+      deriving ( Eq, Show, Typeable )
+

Added: incubator/thrift/trunk/lib/hs/src/Thrift/Transport/Handle.hs
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/lib/hs/src/Thrift/Transport/Handle.hs?rev=763031&view=auto
==============================================================================
--- incubator/thrift/trunk/lib/hs/src/Thrift/Transport/Handle.hs (added)
+++ incubator/thrift/trunk/lib/hs/src/Thrift/Transport/Handle.hs Tue Apr  7 23:29:42 2009
@@ -0,0 +1,58 @@
+--
+-- 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.Handle
+    ( module Thrift.Transport
+    , HandleSource(..)
+    ) where
+
+import Control.Exception ( throw )
+import Control.Monad ( replicateM )
+
+import Network
+
+import System.IO
+import System.IO.Error ( isEOFError )
+
+import Thrift.Transport
+
+
+instance Transport Handle where
+    tIsOpen = hIsOpen
+    tClose h    = hClose h
+    tRead  h n  = replicateM n (hGetChar h) `catch` handleEOF
+    tWrite h s  = mapM_ (hPutChar h) s
+    tFlush = hFlush
+
+
+-- | Type class for all types that can open a Handle. This class is used to
+-- replace tOpen in the Transport type class.
+class HandleSource s where
+    hOpen :: s -> IO Handle
+
+instance HandleSource FilePath where
+    hOpen s = openFile s ReadWriteMode
+
+instance HandleSource (HostName, PortID) where
+    hOpen = uncurry connectTo
+
+
+handleEOF e = if isEOFError e
+    then return []
+    else throw $ TransportExn "TChannelTransport: Could not read" TE_UNKNOWN

Modified: incubator/thrift/trunk/test/hs/Client.hs
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/test/hs/Client.hs?rev=763031&r1=763030&r2=763031&view=diff
==============================================================================
--- incubator/thrift/trunk/test/hs/Client.hs (original)
+++ incubator/thrift/trunk/test/hs/Client.hs Tue Apr  7 23:29:42 2009
@@ -18,18 +18,25 @@
 --
 
 module Client where
-import Thrift
+
 import ThriftTest_Client
 import ThriftTest_Types
-import TSocket
-import TBinaryProtocol
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import Control.Monad
-t = TSocket "127.0.0.1" 9090 Nothing
+import Control.Exception as CE
+
+import Network
+
+import Thrift
+import Thrift.Transport.Handle
+import Thrift.Protocol.Binary
+
+
+serverAddress = ("127.0.0.1", PortNumber 9090)
 
-main = do to <- topen t
-          let p =  TBinaryProtocol to
+main = do to <- hOpen serverAddress
+          let p =  BinaryProtocol to
           let ps = (p,p)
           print =<< testString ps "bya"
           print =<< testByte ps 8
@@ -44,5 +51,8 @@
           print =<< testList ps [1,2,3,4,5]
           print =<< testSet ps (Set.fromList [1,2,3,4,5])
           print =<< testStruct ps (Xtruct (Just "hi") (Just 4) (Just 5) Nothing)
-          tclose to
+          CE.catch (testException ps "e" >> print "bad") (\e -> print (e :: Xception))
+          CE.catch (testMultiException ps "e" "e2" >> print "ok") (\e -> print (e
:: Xception))
+          CE.catch (CE.catch (testMultiException ps "e" "e2">> print "bad") (\e ->
print (e :: Xception2))) (\(e :: SomeException) -> print "ok")
+          tClose to
 

Modified: incubator/thrift/trunk/test/hs/Server.hs
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/test/hs/Server.hs?rev=763031&r1=763030&r2=763031&view=diff
==============================================================================
--- incubator/thrift/trunk/test/hs/Server.hs (original)
+++ incubator/thrift/trunk/test/hs/Server.hs Tue Apr  7 23:29:42 2009
@@ -18,14 +18,16 @@
 --
 
 module Server where
-import Thrift
+
 import ThriftTest
 import ThriftTest_Iface
 import Data.Map as Map
-import TServer
 import Control.Exception
 import ThriftTest_Types
 
+import Thrift
+import Thrift.Server
+
 
 data TestHandler = TestHandler
 instance ThriftTest_Iface TestHandler where
@@ -45,9 +47,11 @@
     testMapMap a (Just x) = return (Map.fromList [(1,Map.fromList [(2,2)])])
     testInsanity a (Just x) = return (Map.fromList [(1,Map.fromList [(ONE,x)])])
     testMulti a a1 a2 a3 a4 a5 a6 = return (Xtruct Nothing Nothing Nothing Nothing)
-    testException a c = throwDyn (Xception (Just 1) (Just "bya"))
-    testMultiException a c1 c2 = return (Xtruct Nothing Nothing Nothing Nothing)
+    testException a c = throw (Xception (Just 1) (Just "bya"))
+    testMultiException a c1 c2 = throw (Xception (Just 1) (Just "xyz"))
     testOneway a (Just i) = do print i
 
 
-main = do (run_basic_server TestHandler process 9090) `catchDyn` (\(TransportExn s t) ->
print s)
+main = do (runBasicServer TestHandler process 9090)
+          `Control.Exception.catch`
+          (\(TransportExn s t) -> print s)

Modified: incubator/thrift/trunk/test/hs/runclient.sh
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/test/hs/runclient.sh?rev=763031&r1=763030&r2=763031&view=diff
==============================================================================
--- incubator/thrift/trunk/test/hs/runclient.sh (original)
+++ incubator/thrift/trunk/test/hs/runclient.sh Tue Apr  7 23:29:42 2009
@@ -19,12 +19,8 @@
 # under the License.
 #
 
-if [ -z $BASE_PKG ]; then
-    BASE_PKG=`ghc-pkg --simple-output list base-3* | sed -e "s/.*\(base-3\(.[0-9]\){3}\).*/\1/"`
-fi
-
 if [ -z $BASE ]; then
     BASE=../..
 fi
 
-ghci -fglasgow-exts -package $BASE_PKG -hide-package syb -i$BASE/lib/hs/src -i$BASE/test/hs/gen-hs
Client.hs
+ghci -fglasgow-exts -i$BASE/lib/hs/src -i$BASE/test/hs/gen-hs Client.hs

Modified: incubator/thrift/trunk/test/hs/runserver.sh
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/test/hs/runserver.sh?rev=763031&r1=763030&r2=763031&view=diff
==============================================================================
--- incubator/thrift/trunk/test/hs/runserver.sh (original)
+++ incubator/thrift/trunk/test/hs/runserver.sh Tue Apr  7 23:29:42 2009
@@ -19,13 +19,9 @@
 # under the License.
 #
 
-if [ -z $BASE_PKG ]; then
-    BASE_PKG=`ghc-pkg --simple-output list base-3* | sed -e "s/.*\(base-3\(.[0-9]\){3}\).*/\1/"`
-fi
-
 if [ -z $BASE ]; then
     BASE=../..
 fi
 
 printf "Starting server... "
-ghc -fglasgow-exts -package $BASE_PKG -hide-package syb -i$BASE/lib/hs/src -i$BASE/test/hs/gen-hs
Server.hs -e "putStrLn \"ready.\" >> Server.main"
+ghc -fglasgow-exts -i$BASE/lib/hs/src -i$BASE/test/hs/gen-hs Server.hs -e "putStrLn \"ready.\"
>> Server.main"



Mime
View raw message