[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 497bd785d126574181dc456a25926daaa70305e4
Author: John Goerzen <jgoerzen at complete.org>
Date:   Tue Dec 21 10:33:35 2004 +0100

    Enhacned memory buf with close func
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--0.7--patch-118)

diff --git a/ChangeLog b/ChangeLog
index f97384b..2732d86 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,19 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
 #
 
+2004-12-21 03:33:35 GMT	John Goerzen <jgoerzen at complete.org>	patch-118
+
+    Summary:
+      Enhacned memory buf with close func
+    Revision:
+      missingh--head--0.7--patch-118
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/IO/HVFS/InstanceHelpers.hs
+     libsrc/MissingH/IO/HVIO.hs testsrc/HVIOtest.hs
+
+
 2004-12-20 22:57:46 GMT	John Goerzen <jgoerzen at complete.org>	patch-117
 
     Summary:
diff --git a/libsrc/MissingH/IO/HVFS/InstanceHelpers.hs b/libsrc/MissingH/IO/HVFS/InstanceHelpers.hs
index 8e79cfa..a4629f6 100644
--- a/libsrc/MissingH/IO/HVFS/InstanceHelpers.hs
+++ b/libsrc/MissingH/IO/HVFS/InstanceHelpers.hs
@@ -35,10 +35,13 @@ Copyright (c) 2004 John Goerzen, jgoerzen\@complete.org
 module MissingH.IO.HVFS.InstanceHelpers(-- * HVFSStat objects
                                         SimpleStat(..),
                                         -- * HVFS objects & types
+                                        -- ** MemoryVFS
                                         MemoryVFS,
                                         newMemoryVFS, newMemoryVFSRef,
                                         MemoryNode,
                                         MemoryEntry(..),
+                                        -- ** FuncVFS
+                                        
                                        )
 where
 import MissingH.IO.HVFS
@@ -170,3 +173,4 @@ instance HVFSOpenable MemoryVFS where
     vOpen x fp _ = vRaiseError x permissionErrorType
                      "Only ReadMode is supported with MemoryVFS files"
                      (Just fp)
+
diff --git a/libsrc/MissingH/IO/HVIO.hs b/libsrc/MissingH/IO/HVIO.hs
index 3c8339d..f92dfe1 100644
--- a/libsrc/MissingH/IO/HVIO.hs
+++ b/libsrc/MissingH/IO/HVIO.hs
@@ -120,7 +120,8 @@ module MissingH.IO.HVIO(-- * Implementation Classes
                      StreamReader, newStreamReader,
 
                      -- ** Memory Buffer
-                     MemoryBuffer, newMemoryBuffer, getMemoryBuffer,
+                     MemoryBuffer, newMemoryBuffer, 
+                     mbDefaultCloseFunc, getMemoryBuffer,
 
                      -- ** Haskell Pipe
                      PipeReader, PipeWriter, newHVIOPipe
@@ -430,7 +431,7 @@ The present 'MemoryBuffer' implementation is rather inefficient, particularly
 when reading towards the end of large files.  It's best used for smallish
 data storage.  This problem will be fixed eventually.
 -}
-newtype MemoryBuffer = MemoryBuffer (VIOCloseSupport (Int, String))
+data MemoryBuffer = MemoryBuffer (String -> IO ()) (VIOCloseSupport (Int, String))
 
 {- | Create a new 'MemoryBuffer' instance.  The buffer is initialized
 to the value passed, and the pointer is placed at the beginning of the file.
@@ -438,12 +439,22 @@ to the value passed, and the pointer is placed at the beginning of the file.
 You can put things in it by using the normal 'vPutStr' calls, and reset to
 the beginning by using the normal 'vRewind' call.
 
+The function is called when 'vClose' is called, and is passed the contents of
+the buffer at close time.  You can use 'mbDefaultCloseFunc' if you don't want to
+do anything.
+
 To create an empty buffer, pass the initial value @\"\"@. -}
-newMemoryBuffer :: String -> IO MemoryBuffer
-newMemoryBuffer init = do ref <- newIORef (True, (0, init))
-                          return (MemoryBuffer ref)
+newMemoryBuffer :: String               -- ^ Initial Contents
+                -> (String -> IO ())    -- ^ close func
+                -> IO MemoryBuffer
+newMemoryBuffer init closefunc = do ref <- newIORef (True, (0, init))
+                                    return (MemoryBuffer closefunc ref)
+
+{- | Default (no-op) memory buf close function. -}
+mbDefaultCloseFunc :: String -> IO ()
+mbDefaultCloseFunc _ = return ()
 
-vrv (MemoryBuffer x) = x
+vrv (MemoryBuffer _ x) = x
 
 {- | Grab the entire contents of the buffer as a string. 
 Unlike 'vGetContents', this has no effect on the open status of the
@@ -456,7 +467,13 @@ instance Show MemoryBuffer where
     show _ = "<MemoryBuffer>"
 
 instance HVIO MemoryBuffer where
-    vClose = vioc_close . vrv
+    vClose x = do wasopen <- vIsOpen x
+                  vioc_close (vrv x)
+                  if wasopen
+                     then do c <- getMemoryBuffer x
+                             case x of
+                                 MemoryBuffer cf _ -> cf c
+                     else return ()
     vIsEOF h = do vTestOpen h
                   c <- vioc_get (vrv h)
                   return ((length (snd c)) == (fst c))
diff --git a/testsrc/HVIOtest.hs b/testsrc/HVIOtest.hs
index 33be098..050d9d4 100644
--- a/testsrc/HVIOtest.hs
+++ b/testsrc/HVIOtest.hs
@@ -29,7 +29,7 @@ ioeq exp inp = do x <- inp
                   exp @=? x
 
 test_MemoryBuffer =
-    let f inp testfunc = TestLabel inp $ TestCase $ do x <- newMemoryBuffer inp
+    let f inp testfunc = TestLabel inp $ TestCase $ do x <- newMemoryBuffer inp mbDefaultCloseFunc
                                                        testfunc x
         in
         [

-- 
haskell-testpack