Browse Source

Exported the std streams

Marcos Dumay de Medeiros 8 years ago
parent
commit
124ae56b0d
2 changed files with 26 additions and 5 deletions
  1. 26 3
      src/System/IO/Uniform/Targets.hs
  2. 0 2
      test/Targets.hs

+ 26 - 3
src/System/IO/Uniform/Targets.hs

@@ -4,7 +4,7 @@
 {-# LANGUAGE InterruptibleFFI #-}
 {-# LANGUAGE EmptyDataDecls #-}
 
-module System.IO.Uniform.Targets (TlsSettings(..), UniformIO(..), SocketIO, FileIO, TlsStream, BoundedPort, SomeIO(..), connectTo, connectToHost, bindPort, accept, openFile, getPeer, closePort) where
+module System.IO.Uniform.Targets (TlsSettings(..), UniformIO(..), SocketIO, FileIO, StdIO, TlsStream, BoundedPort, SomeIO(..), connectTo, connectToHost, bindPort, accept, openFile, getPeer, closePort) where
 
 import Foreign
 import Foreign.C.Types
@@ -74,6 +74,7 @@ newtype SocketIO = SocketIO {sock :: (Ptr Ds)}
 newtype FileIO = FileIO {fd :: (Ptr Ds)}
 data TlsDs
 newtype TlsStream = TlsStream {tls :: (Ptr TlsDs)}
+data StdIO
 
 -- | UniformIO IP connections.
 instance UniformIO SocketIO where
@@ -109,6 +110,28 @@ instance UniformIO SocketIO where
     )
   isSecure _ = False
   
+-- | UniformIO IP connections.
+instance UniformIO StdIO where
+  uRead _ n = do
+    allocaArray n (
+      \b -> do
+        count <- c_recvStd b (fromIntegral n)
+        if count < 0
+          then throwErrno "could not read"
+          else BS.packCStringLen (b, fromIntegral count)
+      )
+  uPut _ t = do
+    BS.useAsCStringLen t (
+      \(str, n) -> do
+        count <- c_sendStd str $ fromIntegral n
+        if count < 0
+          then throwErrno "could not write"
+          else return ()
+      )
+  uClose _ = return ()
+  startTls _ _ = return . TlsStream $ nullPtr
+  isSecure _ = False
+  
 -- | UniformIO type for file IO.
 instance UniformIO FileIO where
   uRead s n = do
@@ -285,9 +308,9 @@ foreign import ccall safe "closeHandler" c_closePort :: Ptr Nethandler -> IO ()
 foreign import ccall safe "closeTls" c_closeTls :: Ptr TlsDs -> IO (Ptr Ds)
 
 foreign import ccall interruptible "sendDs" c_send :: Ptr Ds -> Ptr CChar -> CInt -> IO CInt
---foreign import ccall interruptible "stdDsSend" c_sendStd :: Ptr CChar -> CInt -> IO CInt
+foreign import ccall interruptible "stdDsSend" c_sendStd :: Ptr CChar -> CInt -> IO CInt
 foreign import ccall interruptible "tlsDsSend" c_sendTls :: Ptr TlsDs -> Ptr CChar -> CInt -> IO CInt
 
 foreign import ccall interruptible "recvDs" c_recv :: Ptr Ds -> Ptr CChar -> CInt -> IO CInt
---foreign import ccall interruptible "stdDsRecv" c_recvStd :: Ptr CChar -> CInt -> IO CInt
+foreign import ccall interruptible "stdDsRecv" c_recvStd :: Ptr CChar -> CInt -> IO CInt
 foreign import ccall interruptible "tlsDsRecv" c_recvTls :: Ptr TlsDs -> Ptr CChar -> CInt -> IO CInt

+ 0 - 2
test/Targets.hs

@@ -13,8 +13,6 @@ tests :: IO [Test]
 tests = return [
   simpleTest "network" testNetwork,
   simpleTest "file" testFile,
-  --Test framework fails on this test
-  --actual script works as expected
   simpleTest "network TLS" testTls
   ]