Renamed TlsStream, added function mapOverInput

src/System/IO/Uniform/Targets.hs

@@ -4,7 +4,14 @@
 {-# LANGUAGE InterruptibleFFI #-}
 {-# LANGUAGE EmptyDataDecls #-}
 
-module System.IO.Uniform.Targets (TlsSettings(..), UniformIO(..), SocketIO, FileIO, StdIO, TlsStream, BoundedPort, SomeIO(..), connectTo, connectToHost, bindPort, accept, openFile, getPeer, closePort) where
+module System.IO.Uniform.Targets (
+  TlsSettings(..),
+  UniformIO(..),
+  SocketIO, FileIO, StdIO, TlsIO, SomeIO(..),
+  BoundedPort, connectTo, connectToHost, bindPort, accept, closePort,
+  openFile, getPeer,
+  mapOverInput)
+       where
 
 import Foreign
 import Foreign.C.Types
@@ -37,6 +44,8 @@ class UniformIO a where
   --  Reads a block of at most n bytes of data from the IO target.
   --  Reading will block if there's no data available, but will return immediately
   --  if any amount of data is availble.
+  --
+  --  Must thow System.IO.Error.EOFError if reading beihond EOF.
   uRead  :: a -> Int -> IO ByteString
   -- | uPut fd text
   --
@@ -50,7 +59,7 @@ class UniformIO a where
   -- | startTLS fd
   --
   --  Starts a TLS connection over the IO target.
-  startTls :: TlsSettings -> a -> IO TlsStream
+  startTls :: TlsSettings -> a -> IO TlsIO
   -- | isSecure fd
   --
   --  Indicates whether the data written or read from fd is secure at transport.
@@ -73,7 +82,7 @@ data Ds
 newtype SocketIO = SocketIO {sock :: (Ptr Ds)}
 newtype FileIO = FileIO {fd :: (Ptr Ds)}
 data TlsDs
-newtype TlsStream = TlsStream {tls :: (Ptr TlsDs)}
+newtype TlsIO = TlsIO {tls :: (Ptr TlsDs)}
 data StdIO
 
 -- | UniformIO IP connections.
@@ -104,7 +113,7 @@ instance UniformIO SocketIO where
           r <- c_startSockTls (sock s) cert key para
           if r == nullPtr
             then throwErrno "could not start TLS"
-            else return . TlsStream $ r
+            else return . TlsIO $ r
         )
       )
     )
@@ -129,7 +138,7 @@ instance UniformIO StdIO where
           else return ()
       )
   uClose _ = return ()
-  startTls _ _ = return . TlsStream $ nullPtr
+  startTls _ _ = return . TlsIO $ nullPtr
   isSecure _ = False
   
 -- | UniformIO type for file IO.
@@ -154,12 +163,12 @@ instance UniformIO FileIO where
     f <- Fd <$> c_prepareToClose (fd s)
     closeFd f
   -- Not implemented yet.
-  startTls _ _ = return . TlsStream $ nullPtr
+  startTls _ _ = return . TlsIO $ nullPtr
   isSecure _ = False
   
 -- | UniformIO wrapper that applies TLS to communication on IO target.
 -- This type is constructed by calling startTls on other targets.
-instance UniformIO TlsStream where
+instance UniformIO TlsIO where
   uRead s n = do
     allocaArray n (
       \b -> do
@@ -290,6 +299,18 @@ closeFd (Fd f) = c_closeFd f
 closePort :: BoundedPort -> IO ()
 closePort p = c_closePort (lis p)
 
+-- | mapOverInput io block_size f initial
+--   Reads io untill the end of file, evaluating a(i) <- f a(i-1) read_data
+--   where a(0) = initial and the last value after io reaches EOF is returned.
+--
+--   Notice that the length of read_data might not be equal block_size.
+mapOverInput :: UniformIO io => io -> Int -> (a -> ByteString -> a) -> a -> IO a
+mapOverInput io block f initial = do
+  a <- tryIOError $ uRead io block
+  case a of
+    Left e -> if isEOFError e then return initial else throw e -- EOF
+    Right dt -> mapOverInput io block f (f initial dt)
+
 foreign import ccall interruptible "getPort" c_getPort :: CInt -> IO (Ptr Nethandler)
 foreign import ccall interruptible "createFromHandler" c_accept :: Ptr Nethandler -> IO (Ptr Ds)
 foreign import ccall safe "createFromFileName" c_createFile :: CString -> IO (Ptr Ds)