{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Thrift.Transport.Handle
( module Thrift.Transport
, HandleSource(..)
) where
import Control.Exception ( catch, throw )
import Data.ByteString.Internal (c2w)
import Data.Functor
import Network
import System.IO
import System.IO.Error ( isEOFError )
import Thrift.Transport
import qualified Data.ByteString.Lazy as LBS
import Data.Monoid
instance Transport Handle where
tIsOpen = hIsOpen
tClose = hClose
tRead h n = read `Control.Exception.catch` handleEOF mempty
where
read = do
hLookAhead h
LBS.hGetNonBlocking h n
tReadAll _ 0 = return mempty
tReadAll h n = LBS.hGet h n `Control.Exception.catch` throwTransportExn
tPeek h = (Just . c2w <$> hLookAhead h) `Control.Exception.catch` handleEOF Nothing
tWrite = LBS.hPut
tFlush = hFlush
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
throwTransportExn :: IOError -> IO a
throwTransportExn e = if isEOFError e
then throw $ TransportExn "Cannot read. Remote side has closed." TE_UNKNOWN
else throw $ TransportExn "Handle tReadAll: Could not read" TE_UNKNOWN
handleEOF :: a -> IOError -> IO a
handleEOF a e = if isEOFError e
then return a
else throw $ TransportExn "Handle: Could not read" TE_UNKNOWN