1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374 |
- -- {-# LANGUAGE OverloadedStrings #-}
- -- {-# LANGUAGE ExistentialQuantification #-}
- -- {-# LANGUAGE ForeignFunctionInterface #-}
- -- {-# LANGUAGE InterruptibleFFI #-}
- -- {-# LANGUAGE EmptyDataDecls #-}
- module System.IO.Uniform.ByteString (
- ByteStringIO,
- withByteStringIO, withByteStringIO'
- ) where
- import System.IO.Uniform
- import System.IO.Uniform.External
- import Foreign
- --import Foreign.C.Types
- --import Foreign.C.String
- --import Foreign.C.Error
- -- import qualified Data.IP as IP
- import Data.ByteString (ByteString)
- import qualified Data.ByteString as BS
- import qualified Data.ByteString.Lazy as LBS
- import qualified Data.ByteString.Builder as BSBuild
- --import qualified Data.List as L
- --import Control.Exception
- --import Control.Applicative ((<$>))
- import Data.Monoid (mappend)
- --import qualified Network.Socket as Soc
- import System.IO.Error
- import Control.Concurrent.MVar
- --import Data.Default.Class
- --import System.Posix.Types (Fd(..))
- -- | Wrapper that does UniformIO that reads and writes on the memory.
- data ByteStringIO = ByteStringIO {bsioinput :: MVar (ByteString, Bool), bsiooutput :: MVar BSBuild.Builder}
- instance UniformIO ByteStringIO where
- uRead s n = do
- (i, eof) <- takeMVar . bsioinput $ s
- if eof
- then do
- putMVar (bsioinput s) (i, eof)
- ioError $ mkIOError eofErrorType "read past end of input" Nothing Nothing
- else do
- let (r, i') = BS.splitAt n i
- let eof' = (BS.null r && n > 0)
- putMVar (bsioinput s) (i', eof')
- return r
- uPut s t = do
- o <- takeMVar . bsiooutput $ s
- let o' = mappend o $ BSBuild.byteString t
- putMVar (bsiooutput s) o'
- uClose _ = return ()
- startTls _ _ = return . TlsIO $ nullPtr
- isSecure _ = True
- -- | withByteStringIO input f
- -- Runs f with a ByteStringIO that has the given input, returns f's output and
- -- the ByteStringIO output.
- withByteStringIO :: ByteString -> (ByteStringIO -> IO a) -> IO (a, LBS.ByteString)
- withByteStringIO input f = do
- ivar <- newMVar (input, False)
- ovar <- newMVar . BSBuild.byteString $ BS.empty
- let bsio = ByteStringIO ivar ovar
- a <- f bsio
- out <- takeMVar . bsiooutput $ bsio
- return (a, BSBuild.toLazyByteString out)
- -- | The same as withByteStringIO, but returns an strict ByteString
- withByteStringIO' :: ByteString -> (ByteStringIO -> IO a) -> IO (a, ByteString)
- withByteStringIO' input f = do
- (a, t) <- withByteStringIO input f
- return (a, LBS.toStrict t)
|