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/Protocol.hs b/lib/hs/src/Thrift/Protocol.hs
new file mode 100644
index 0000000..8fa060e
--- /dev/null
+++ b/lib/hs/src/Thrift/Protocol.hs
@@ -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