Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Support all function in N.S.ByteString.Lazy on Windows

Fixes #135.
  • Loading branch information...
commit e356a2e659e2915da71694b0614edb41e465f9fe 1 parent 005a5b5
@tibbe tibbe authored
View
56 Network/Socket/ByteString/Lazy/Posix.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE BangPatterns #-}
+module Network.Socket.ByteString.Lazy.Posix
+ (
+ -- * Send data to a socket
+ send
+ , sendAll
+ ) where
+
+import Control.Monad (liftM)
+import Control.Monad (unless)
+import qualified Data.ByteString.Lazy as L
+import Data.ByteString.Lazy.Internal (ByteString(..))
+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
+import Data.Int (Int64)
+import Foreign.Marshal.Array (allocaArray)
+import Foreign.Ptr (plusPtr)
+import Foreign.Storable (Storable(..))
+
+import Network.Socket (Socket(..))
+import Network.Socket.ByteString.IOVec (IOVec(IOVec))
+import Network.Socket.ByteString.Internal (c_writev)
+import Network.Socket.Internal
+
+-- -----------------------------------------------------------------------------
+-- Sending
+
+send :: Socket -- ^ Connected socket
+ -> ByteString -- ^ Data to send
+ -> IO Int64 -- ^ Number of bytes sent
+send sock@(MkSocket fd _ _ _ _) s = do
+ let cs = take maxNumChunks (L.toChunks s)
+ len = length cs
+ liftM fromIntegral . allocaArray len $ \ptr ->
+ withPokes cs ptr $ \niovs ->
+ throwSocketErrorWaitWrite sock "writev" $
+ c_writev (fromIntegral fd) ptr niovs
+ where
+ withPokes ss p f = loop ss p 0 0
+ where loop (c:cs) q k !niovs
+ | k < maxNumBytes =
+ unsafeUseAsCStringLen c $ \(ptr,len) -> do
+ poke q $ IOVec ptr (fromIntegral len)
+ loop cs (q `plusPtr` sizeOf (undefined :: IOVec))
+ (k + fromIntegral len) (niovs + 1)
+ | otherwise = f niovs
+ loop _ _ _ niovs = f niovs
+ maxNumBytes = 4194304 :: Int -- maximum number of bytes to transmit in one system call
+ maxNumChunks = 1024 :: Int -- maximum number of chunks to transmit in one system call
+
+sendAll :: Socket -- ^ Connected socket
+ -> ByteString -- ^ Data to send
+ -> IO ()
+sendAll sock bs = do
+ sent <- send sock bs
+ let bs' = L.drop sent bs
+ unless (L.null bs') $ sendAll sock bs'
View
36 Network/Socket/ByteString/Lazy/Windows.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE BangPatterns #-}
+module Network.Socket.ByteString.Lazy.Windows
+ (
+ -- * Send data to a socket
+ send
+ , sendAll
+ ) where
+
+import Control.Applicative ((<$>))
+import Control.Monad (unless)
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Lazy as L
+import Data.Int (Int64)
+
+import Network.Socket (Socket(..))
+import qualified Network.Socket.ByteString as Socket
+
+-- -----------------------------------------------------------------------------
+-- Sending
+
+send :: Socket -- ^ Connected socket
+ -> L.ByteString -- ^ Data to send
+ -> IO Int64 -- ^ Number of bytes sent
+send sock s = do
+ fromIntegral <$> case L.toChunks s of
+ -- TODO: Consider doing nothing if the string is empty.
+ [] -> Socket.send sock S.empty
+ (x:_) -> Socket.send sock x
+
+sendAll :: Socket -- ^ Connected socket
+ -> L.ByteString -- ^ Data to send
+ -> IO ()
+sendAll sock bs = do
+ sent <- send sock bs
+ let bs' = L.drop sent bs
+ unless (L.null bs') $ sendAll sock bs'
View
7 network.cabal
@@ -37,7 +37,11 @@ library
if !os(windows)
other-modules:
Network.Socket.ByteString.IOVec
+ Network.Socket.ByteString.Lazy.Posix
Network.Socket.ByteString.MsgHdr
+ if os(windows)
+ other-modules:
+ Network.Socket.ByteString.Lazy.Windows
build-depends:
base >= 3 && < 5,
@@ -54,8 +58,7 @@ library
includes: HsNet.h
install-includes: HsNet.h HsNetworkConfig.h
c-sources: cbits/HsNet.c
- if impl(ghc >= 6.8)
- ghc-options: -fwarn-tabs
+ ghc-options: -Wall -fwarn-tabs
test-suite simple
hs-source-dirs: tests
Please sign in to comment.
Something went wrong with that request. Please try again.