[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 184e350e1966d21845bcf1e5f55cfa37524c3144
Author: John Goerzen <jgoerzen at complete.org>
Date:   Thu Dec 16 03:45:05 2004 +0100

    Checkpointing
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--0.7--patch-76)

diff --git a/ChangeLog b/ChangeLog
index 96ca515..b9b81d5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,18 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
 #
 
+2004-12-15 20:45:05 GMT	John Goerzen <jgoerzen at complete.org>	patch-76
+
+    Summary:
+      Checkpointing
+    Revision:
+      missingh--head--0.7--patch-76
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/HVIO.hs
+
+
 2004-12-15 20:34:40 GMT	John Goerzen <jgoerzen at complete.org>	patch-75
 
     Summary:
diff --git a/libsrc/MissingH/HVIO.hs b/libsrc/MissingH/HVIO.hs
index b39f465..ffc5d19 100644
--- a/libsrc/MissingH/HVIO.hs
+++ b/libsrc/MissingH/HVIO.hs
@@ -166,7 +166,7 @@ class (HVIOGeneric a) => HVIOWriter a where
 
     vPrint h s = vPutStrLn h (show s)
                  
-    vFlush _ = return ()
+    vFlush = vTestOpen
 
 {- | Seekable items.  Implementators must provide all functions.
 
@@ -267,7 +267,9 @@ instance HVIOReader StreamReader where
 -- Pipes
 ----------------------------------------------------------------------
 
--- newPipe :: (PipeReader, PipeWriter)
+newPipe :: IO (PipeReader, PipeWriter)
+newPipe = do mv <- newEmptyMVar
+             return (PipeReader (True, mv), PipeWriter (True, mv))
 
 data PipeBit = PipeBit Char 
              | PipeEOF
@@ -276,6 +278,10 @@ data PipeBit = PipeBit Char
 newtype PipeReader = PipeReader (VIOCloseSupport (MVar PipeBit))
 newtype PipeWriter = PipeWriter (VIOCloseSupport (MVar PipeBit))
 
+------------------------------
+-- Pipe Reader
+------------------------------
+
 prv (PipeReader x) = x
 
 instance Show PipeReader where
@@ -308,3 +314,28 @@ instance HVIOReader PipeReader where
         in do vTestEOF h
               loop
                         
+------------------------------
+-- Pipe Writer
+------------------------------
+
+pwv (PipeWriter x) = x
+
+instance Show PipeWriter where
+    show x = "<PipeWriter>"
+
+instance HVIOGeneric PipeWriter where
+    vClose h = do o <- vIsOpen h
+                  if o then do
+                            mv <- vioc_get (pwv h)
+                            putMVar mv PipeEOF
+                            vioc_close (pwv h)
+                     else return ()
+    vIsOpen = vioc_isopen . pwv
+    vIsEOF h = vTestOpen h
+               return False
+
+instance HVIOWriter PipeWriter where
+    vPutChar h c = do vTestOpen h
+                      mv <- voic_get (pwv h)
+                      putMVar mv (PipeBit c)
+

-- 
haskell-testpack