]>
Commit | Line | Data |
---|---|---|
f67539c2 TL |
1 | {-# LANGUAGE FlexibleInstances #-} |
2 | {-# LANGUAGE MultiParamTypeClasses #-} | |
3 | {-# LANGUAGE ScopedTypeVariables #-} | |
4 | {-# LANGUAGE TypeSynonymInstances #-} | |
5 | {-# OPTIONS_GHC -fno-warn-orphans #-} | |
6 | -- | |
7 | -- Licensed to the Apache Software Foundation (ASF) under one | |
8 | -- or more contributor license agreements. See the NOTICE file | |
9 | -- distributed with this work for additional information | |
10 | -- regarding copyright ownership. The ASF licenses this file | |
11 | -- to you under the Apache License, Version 2.0 (the | |
12 | -- "License"); you may not use this file except in compliance | |
13 | -- with the License. You may obtain a copy of the License at | |
14 | -- | |
15 | -- http://www.apache.org/licenses/LICENSE-2.0 | |
16 | -- | |
17 | -- Unless required by applicable law or agreed to in writing, | |
18 | -- software distributed under the License is distributed on an | |
19 | -- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY | |
20 | -- KIND, either express or implied. See the License for the | |
21 | -- specific language governing permissions and limitations | |
22 | -- under the License. | |
23 | -- | |
24 | ||
25 | module Thrift.Transport.Handle | |
26 | ( module Thrift.Transport | |
27 | , HandleSource(..) | |
28 | ) where | |
29 | ||
30 | import Control.Exception ( catch, throw ) | |
31 | import Data.ByteString.Internal (c2w) | |
32 | import Data.Functor | |
33 | ||
34 | import Network | |
35 | ||
36 | import System.IO | |
37 | import System.IO.Error ( isEOFError ) | |
38 | ||
39 | import Thrift.Transport | |
40 | ||
41 | import qualified Data.ByteString.Lazy as LBS | |
42 | import Data.Monoid | |
43 | ||
44 | instance Transport Handle where | |
45 | tIsOpen = hIsOpen | |
46 | tClose = hClose | |
47 | tRead h n = read `Control.Exception.catch` handleEOF mempty | |
48 | where | |
49 | read = do | |
50 | hLookAhead h | |
51 | LBS.hGetNonBlocking h n | |
52 | tReadAll _ 0 = return mempty | |
53 | tReadAll h n = LBS.hGet h n `Control.Exception.catch` throwTransportExn | |
54 | tPeek h = (Just . c2w <$> hLookAhead h) `Control.Exception.catch` handleEOF Nothing | |
55 | tWrite = LBS.hPut | |
56 | tFlush = hFlush | |
57 | ||
58 | ||
59 | -- | Type class for all types that can open a Handle. This class is used to | |
60 | -- replace tOpen in the Transport type class. | |
61 | class HandleSource s where | |
62 | hOpen :: s -> IO Handle | |
63 | ||
64 | instance HandleSource FilePath where | |
65 | hOpen s = openFile s ReadWriteMode | |
66 | ||
67 | instance HandleSource (HostName, PortID) where | |
68 | hOpen = uncurry connectTo | |
69 | ||
70 | throwTransportExn :: IOError -> IO a | |
71 | throwTransportExn e = if isEOFError e | |
72 | then throw $ TransportExn "Cannot read. Remote side has closed." TE_UNKNOWN | |
73 | else throw $ TransportExn "Handle tReadAll: Could not read" TE_UNKNOWN | |
74 | ||
75 | handleEOF :: a -> IOError -> IO a | |
76 | handleEOF a e = if isEOFError e | |
77 | then return a | |
78 | else throw $ TransportExn "Handle: Could not read" TE_UNKNOWN |