[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36

[John Goerzen]

The following commit has been merged in the master branch:
commit b8a27cf8e3cbe820cfc980e1dfb32b6c981f04f6
Author: John Goerzen <jgoerzen at complete.org>
Date:   Mon Oct 10 06:56:19 2005 +0100

    Added binary file I/O to HVIO and HVFS

diff --git a/MissingH/IO/HVFS.hs b/MissingH/IO/HVFS.hs
index 50bd448..25b501f 100644
--- a/MissingH/IO/HVFS.hs
+++ b/MissingH/IO/HVFS.hs
@@ -243,6 +243,7 @@ class HVFS a => HVFSOpenable a where
     vOpen :: a -> FilePath -> IOMode -> IO HVFSOpenEncap
     vReadFile :: a -> FilePath -> IO String
     vWriteFile :: a -> FilePath -> String -> IO ()
+    vOpenBinaryFile :: a -> FilePath -> IOMode -> IO HVFSOpenEncap
 
     vReadFile h fp = 
         do oe <- vOpen h fp ReadMode
@@ -253,6 +254,9 @@ class HVFS a => HVFSOpenable a where
            withOpen oe (\fh -> do vPutStr fh s
                                   vClose fh)
 
+    -- | Open a file in binary mode.
+    vOpenBinaryFile = vOpen
+
 instance Show FileStatus where
     show _ = "<FileStatus>"
 
@@ -314,3 +318,5 @@ instance HVFS SystemFS where
 
 instance HVFSOpenable SystemFS where
     vOpen _ fp iomode = openFile fp iomode >>= return . HVFSOpenEncap
+    vOpenBinaryFile _ fp iomode = openBinaryFile fp iomode >>= return . HVFSOpenEncap
+
diff --git a/MissingH/IO/HVIO.hs b/MissingH/IO/HVIO.hs
index 6c8bcdd..5dcff80 100644
--- a/MissingH/IO/HVIO.hs
+++ b/MissingH/IO/HVIO.hs
@@ -133,6 +133,9 @@ import System.IO
 import System.IO.Error
 import Control.Concurrent.MVar
 import Data.IORef
+import Foreign.Ptr
+import Foreign.C
+import Foreign.Storable
 
 {- | This is the generic I\/O support class.  All objects that are to be used
 in the HVIO system must provide an instance of 'HVIO'.
@@ -249,6 +252,17 @@ class (Show a) => HVIO a where
     -- | Get buffering; the default action always returns NoBuffering.
     vGetBuffering :: a -> IO BufferMode
 
+    -- | Binary output: write the specified number of octets from the specified
+    -- buffer location.
+    vPutBuf :: a -> Ptr b -> Int -> IO ()
+
+    -- | Binary input: read the specified number of octets from the
+    -- specified buffer location, continuing to read
+    -- until it either consumes that much data or EOF is encountered.
+    -- Returns the number of octets actually read.  EOF errors are never
+    -- raised; fewer bytes than requested are returned on EOF.
+    vGetBuf :: a -> Ptr b -> Int -> IO Int
+
     vSetBuffering x _ = return ()
     vGetBuffering x = return NoBuffering
 
@@ -331,6 +345,23 @@ class (Show a) => HVIO a where
     vGetChar h = vThrow h illegalOperationErrorType
     
 
+    vPutBuf h buf len =
+        do str <- peekCStringLen (castPtr buf, len)
+           vPutStr h str
+
+    vGetBuf h b l = 
+        worker b l 0
+        where worker _ 0 accum = return accum
+              worker buf len accum =
+                  do iseof <- vIsEOF h
+                     if iseof
+                        then return accum
+                        else do c <- vGetChar h
+                                let cc = castCharToCChar c
+                                poke (castPtr buf) cc
+                                let newptr = plusPtr buf 1
+                                worker newptr (len - 1) (accum + 1)
+
 ----------------------------------------------------------------------
 -- Handle instances
 ----------------------------------------------------------------------
@@ -357,6 +388,8 @@ instance HVIO Handle where
     vIsSeekable = hIsSeekable
     vSetBuffering = hSetBuffering
     vGetBuffering = hGetBuffering
+    vGetBuf = hGetBuf
+    vPutBuf = hPutBuf
 
 ----------------------------------------------------------------------
 -- VIO Support

-- 
haskell-testpack