THRIFT-407. hs: Refactor and improve Haskell-related code
git-svn-id: https://svn.apache.org/repos/asf/incubator/thrift/trunk@763031 13f79535-47bb-0310-9956-ffa450edef68
diff --git a/lib/hs/src/Thrift.hs b/lib/hs/src/Thrift.hs
index 293edf1..291bcae 100644
--- a/lib/hs/src/Thrift.hs
+++ b/lib/hs/src/Thrift.hs
@@ -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
+module Thrift
+ ( module Thrift.Transport
+ , module Thrift.Protocol
+ , AppExnType(..)
+ , AppExn(..)
+ , readAppExn
+ , writeAppExn
+ , ThriftException(..)
+ ) where
- data Thrift_exception = Thrift_Error deriving Typeable
+import Control.Monad ( when )
+import Control.Exception
- data TransportExn_Type = TE_UNKNOWN
- | TE_NOT_OPEN
- | TE_ALREADY_OPEN
- | TE_TIMED_OUT
- | TE_END_OF_FILE
- deriving (Eq,Typeable,Show)
+import Data.Typeable ( Typeable )
- 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)
+import Thrift.Transport
+import Thrift.Protocol
- 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 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 )
- data Message_type = M_CALL
- | M_REPLY
- | M_EXCEPTION
- | M_ONEWAY
- | M_UNKNOWN
- deriving Eq
- instance Enum Message_type where
+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 t = case t of
- M_CALL -> 1
- M_REPLY -> 2
- M_EXCEPTION -> 3
- M_ONEWAY -> 4
- M_UNKNOWN -> -1
+ 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
- toEnum t = case t of
- 1 -> M_CALL
- 2 -> M_REPLY
- 3 -> M_EXCEPTION
- 4 -> M_ONEWAY
- _ -> M_UNKNOWN
+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
- 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 ()
+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
-
- 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
-
+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