blob: a04739a24ddf7bd559b46ae90f72f1966c61e07d [file] [log] [blame]
David Reissea2cba82009-03-30 21:35:00 +00001--
2-- Licensed to the Apache Software Foundation (ASF) under one
3-- or more contributor license agreements. See the NOTICE file
4-- distributed with this work for additional information
5-- regarding copyright ownership. The ASF licenses this file
6-- to you under the Apache License, Version 2.0 (the
7-- "License"); you may not use this file except in compliance
8-- with the License. You may obtain a copy of the License at
9--
10-- http://www.apache.org/licenses/LICENSE-2.0
11--
12-- Unless required by applicable law or agreed to in writing,
13-- software distributed under the License is distributed on an
14-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
15-- KIND, either express or implied. See the License for the
16-- specific language governing permissions and limitations
17-- under the License.
18--
19
iproctorff8eb922007-07-25 19:06:13 +000020module TSocket(TSocket(..)) where
21import Thrift
22import Data.IORef
23import Network
24import IO
25import Control.Exception
26data TSocket = TSocket{host::[Char],port::PortNumber,chan :: Maybe Handle}
27
28instance TTransport TSocket where
29 tisOpen a = case chan a of
30 Just _ -> True
31 Nothing -> False
32 topen a = do h <- connectTo (host a) (PortNumber (port a))
David Reiss0c90f6f2008-02-06 22:18:40 +000033 return $ (a{chan = Just h})
34 tclose a = case chan a of
iproctorff8eb922007-07-25 19:06:13 +000035 Just h -> do hClose h
36 return $ a{chan=Nothing}
37 Nothing -> return a
38 tread a 0 = return []
David Reiss0c90f6f2008-02-06 22:18:40 +000039 tread a n = case chan a of
iproctorff8eb922007-07-25 19:06:13 +000040 Just h -> handle (\e -> throwDyn (TransportExn "TSocket: Could not read." TE_UNKNOWN))
David Reiss0c90f6f2008-02-06 22:18:40 +000041 (do c <- hGetChar h
iproctorff8eb922007-07-25 19:06:13 +000042 l <- tread a (n-1)
43 return $ c:l)
44 Nothing -> return []
45 twrite a s = case chan a of
46 Just h -> hPutStr h s
47 Nothing -> return ()
48 tflush a = case chan a of
49 Just h -> hFlush h
50 Nothing -> return ()
51
52