[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 806d44aa0f293a9edec042766fe2b09a42d90c1b
Author: John Goerzen <jgoerzen at complete.org>
Date:   Thu Dec 16 02:23:05 2004 +0100

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

diff --git a/ChangeLog b/ChangeLog
index b717bea..053221b 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 19:23:05 GMT	John Goerzen <jgoerzen at complete.org>	patch-71
+
+    Summary:
+      Checkpointing
+    Revision:
+      missingh--head--0.7--patch-71
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/HVIO.hs
+
+
 2004-12-15 19:14:04 GMT	John Goerzen <jgoerzen at complete.org>	patch-70
 
     Summary:
diff --git a/libsrc/MissingH/HVIO.hs b/libsrc/MissingH/HVIO.hs
index dbf9b03..a840aa1 100644
--- a/libsrc/MissingH/HVIO.hs
+++ b/libsrc/MissingH/HVIO.hs
@@ -36,9 +36,10 @@ module MissingH.HVIO(-- * Implementation Classes
                      HVIOGeneric(..), 
                      HVIOReader(..),
                      HVIOWriter(..),
-                     HVIOSeeker(..)
+                     HVIOSeeker(..),
                      -- * Standard Virtual IO features
                      -- | Note: Handle is a member of all classes by default.
+                     StreamReader
                     )
 where
 
@@ -98,13 +99,15 @@ class (Show a) => HVIOGeneric a where
                         else return ()
 
 {- | Readers.  Implementators must provide at least 'vGetChar'.
+An implementation of 'vGetContents' is also highly suggested, since
+the default cannot implement quick closing.
 -}
 class (HVIOGeneric a) => HVIOReader a where
     -- | Read one character
     vGetChar :: a -> IO Char
     -- | Read one line
     vGetLine :: a -> IO String
-    -- | Get the remaining contents
+    -- | Get the remaining contents.  
     vGetContents :: a -> IO String
     -- | Indicate whether at least one item is ready for reading.
     vReady :: a -> IO Bool
@@ -203,10 +206,10 @@ vioc_get :: VIOCloseSupport a -> IO a
 vioc_get x = readIORef x >>= return . snd
 
 vioc_close :: VIOCloseSupport a -> IO ()
-vioc_close x = modifyIORef x (\ (_, dat) -> (False, dat))
+vioc_close x = modifyIORef x (\ _ -> (False, undefined))
 
-vioc_update :: VIOCloseSupport a -> a -> IO ()
-vioc_update x newdat = modifyIORef x (\ (stat, _) -> (stat, newdat))
+vioc_set :: VIOCloseSupport a -> a -> IO ()
+vioc_set x newdat = modifyIORef x (\ (stat, _) -> (stat, newdat))
 
 ----------------------------------------------------------------------
 -- Stream Readers/Writers
@@ -217,3 +220,29 @@ vioc_update x newdat = modifyIORef x (\ (stat, _) -> (stat, newdat))
 This is lazy!
  -}
 newtype StreamReader = StreamReader (VIOCloseSupport String)
+
+srv (StreamReader x) = x
+instance Show StreamReader where
+    show _ = "<StreamReader>"
+
+instance HVIOGeneric StreamReader where
+    vClose = vioc_close . srv
+    vIsEOF h = do vTestOpen h
+                  d <- vioc_get (srv h)
+                  return $ case d of
+                                  [] -> True
+                                  _ -> False
+    vIsOpen = vioc_isopen . srv
+
+instance HVIOReader StreamReader where
+    vGetChar h = do vTestEOF h
+                    c <- vioc_get (srv h)
+                    let retval = head c
+                    vioc_set (srv h) (tail c)
+                    return retval
+    
+    vGetContents h = do vTestEOF h
+                        c <- vioc_get (srv h)
+                        vClose h
+                        return c
+

-- 
haskell-testpack