    {-# LANGUAGE Safe #-}

    {- arch-tag: HVIO main file
    Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org>

    All rights reserved.

    For license and copyright information, see the file LICENSE
    -}

    {- |
       Module     : System.IO.HVIO
       Copyright  : Copyright (C) 2004-2011 John Goerzen
       SPDX-License-Identifier: BSD-3-Clause

       Stability  : stable
       Portability: portable

    Haskell Virtual I\/O -- a system to increase the flexibility of input and
    output in Haskell

    Copyright (c) 2004-2005 John Goerzen, jgoerzen\@complete.org

    HVIO provides the following general features:

     * The ability to use a single set of functions on various different
       types of objects, including standard Handles, in-memory buffers,
       compressed files, network data streams, etc.

     * The ability to transparently add filters to the I\/O process.
       These filters could include things such as character set conversions,
       compression or decompression of a data stream, and more.

     * The ability to define new objects that have the properties
       of I\/O objects and can be used interchangably with them.

     * Specification compatibility with, and complete support for,
       existing I\/O on Handles.

     * Provide easier unit testing capabilities for I\/O actions

    HVIO defines several basic type classes that you can use.  You will mostly
    be interested in 'HVIO'.

    It's trivial to adapt old code to work with HVIO.  For instance, consider
    this example of old and new code:

    >printMsg :: Handle -> String -> IO ()
    >printMsg h msg = hPutStr h ("msg: " ++ msg)

    And now, the new way:

    >printMsg :: HVIO h => h -> String -> IO ()
    >printMsg h msg = vPutStr h ("msg: " ++ msg)

    There are several points to note about this conversion:

     * The new method can still accept a Handle in exactly the same way as
       the old method.  Changing your functions to use HVIO will require no
       changes from functions that call them with Handles.

     * Most \"h\" functions have equivolent \"v\" functions that operate
       on HVIO classes instead of the more specific Handle.  The \"v\" functions
       behave identically to the \"h\" functions whenever possible.

     * There is no equivolent of \"openFile\" in any HVIO class.  You must
       create your Handle (or other HVIO object) using normal means.
       This is because the creation is so different that it cannot be standardized.

    In addition to Handle, there are several pre-defined classes for your use.
    'StreamReader' is a particularly interesting one.  At creation time, you pass
    it a String.  Its contents are read lazily whenever a read call is made.  It
    can be used, therefore, to implement filters (simply initialize it with the
    result from, say, a map over hGetContents from another HVIO object), codecs,
    and simple I\/O testing.  Because it is lazy, it need not hold the entire
    string in memory.  You can create a 'StreamReader' with a call to
    'newStreamReader'.

    'MemoryBuffer' is a similar class, but with a different purpose.  It provides
    a full interface like Handle (it implements 'HVIOReader', 'HVIOWriter',
    and 'HVIOSeeker').  However, it maintains an in-memory buffer with the
    contents of the file, rather than an actual on-disk file.  You can access
    the entire contents of this buffer at any time.  This can be quite useful
    for testing I\/O code, or for cases where existing APIs use I\/O, but you
    prefer a String representation.  You can create a 'MemoryBuffer' with a call
    to 'newMemoryBuffer'.

    Finally, there are pipes.  These pipes are analogous to the Unix
    pipes that are available from System.Posix, but don't require Unix and work
    only in Haskell.  When you create a pipe, you actually get two HVIO objects:
    a 'PipeReader' and a 'PipeWriter'.  You must use the 'PipeWriter' in one
    thread and the 'PipeReader' in another thread.  Data that's written to the
    'PipeWriter' will then be available for reading with the 'PipeReader'.  The
    pipes are implemented completely with existing Haskell threading primitives,
    and require no special operating system support.  Unlike Unix pipes, these
    pipes cannot be used across a fork().  Also unlike Unix pipes, these pipes
    are portable and interact well with Haskell threads.  A new pipe can be created
    with a call to 'newHVIOPipe'.

    Together with "System.IO.HVFS", this module is part of a complete
    virtual filesystem solution.
    -}

    module System.IO.HVIO(-- * Implementation Classes
                         HVIO(..),
                         -- * Standard HVIO Implementations

                         -- ** Handle
                         -- | Handle is a member of 'HVIO'.

                         -- ** Stream Reader
                         StreamReader, newStreamReader,

                         -- ** Memory Buffer
                         MemoryBuffer, newMemoryBuffer,
                         mbDefaultCloseFunc, getMemoryBuffer,

                         -- ** Haskell Pipe
                         PipeReader, PipeWriter, newHVIOPipe
                        )
    where

    import safe Control.Concurrent.MVar
        ( newEmptyMVar, putMVar, readMVar, takeMVar, MVar )
    import qualified Control.Exception       (catch)
    import safe Data.IORef ( IORef, modifyIORef, newIORef, readIORef )
    import safe Foreign.C ( castCharToCChar, peekCStringLen )
    import safe Foreign.Ptr ( Ptr, castPtr, plusPtr )
    import safe Foreign.Storable ( Storable(poke) )
    import safe System.IO
        ( Handle,
          hClose,
          hFlush,
          hGetBuffering,
          hIsClosed,
          hIsEOF,
          hIsOpen,
          hIsReadable,
          hIsSeekable,
          hIsWritable,
          hSeek,
          hSetBuffering,
          hShow,
          hTell,
          hGetBuf,
          hGetChar,
          hGetContents,
          hGetLine,
          hPutBuf,
          hPutChar,
          hPutStr,
          hPutStrLn,
          hPrint,
          hReady,
          SeekMode(..),
          BufferMode(NoBuffering) )
    import safe System.IO.Error
        ( IOErrorType,
          eofErrorType,
          illegalOperationErrorType,
          isEOFError,
          mkIOError )

    {- | 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'.

    Functions in this class provide an interface with the same specification as
    the similar functions in System.IO.  Please refer to that documentation
    for a more complete specification than is provided here.

    Instances of 'HVIO' must provide 'vClose', 'vIsEOF', and either
    'vIsOpen' or 'vIsClosed'.

    Implementators of readable objects must provide at least 'vGetChar'
    and 'vIsReadable'.
    An implementation of 'vGetContents' is also highly suggested, since
    the default cannot implement proper partial closing semantics.

    Implementators of writable objects must provide at least 'vPutChar' and
    'vIsWritable'.

    Implementators of seekable objects must provide at least
    'vIsSeekable', 'vTell', and 'vSeek'.
    -}
    class (Show a) => HVIO a where
        -- | Close a file
        vClose :: a -> IO ()
        -- | Test if a file is open
        vIsOpen :: a -> IO Bool
        -- | Test if a file is closed
        vIsClosed :: a -> IO Bool
        -- | Raise an error if the file is not open.
        -- This is a new HVIO function and is implemented in terms of
        -- 'vIsOpen'.
        vTestOpen :: a -> IO ()
        -- | Whether or not we're at EOF.  This may raise on exception
        -- on some items, most notably write-only Handles such as stdout.
        -- In general, this is most reliable on items opened for reading.
        -- vIsEOF implementations must implicitly call vTestOpen.
        vIsEOF :: a -> IO Bool
        -- | Detailed show output.
        vShow :: a -> IO String
        -- | Make an IOError.
        vMkIOError :: a -> IOErrorType -> String -> Maybe FilePath -> IOError
        -- | Throw an IOError.
        vThrow :: a -> IOErrorType -> IO b
        -- | Get the filename\/object\/whatever that this corresponds to.
        -- May be Nothing.
        vGetFP :: a -> IO (Maybe FilePath)
        -- | Throw an isEOFError if we're at EOF; returns nothing otherwise.
        -- If an implementation overrides the default, make sure that it
        -- calls vTestOpen at some point.  The default implementation is
        -- a wrapper around a call to 'vIsEOF'.
        vTestEOF :: a -> IO ()

        -- | Read one character
        vGetChar :: a -> IO Char
        -- | Read one line
        vGetLine :: a -> IO String
        {- | Get the remaining contents.  Please note that as a user of this
           function, the same partial-closing semantics as are used in the
           standard 'hGetContents' are /encouraged/ from implementators,
           but are not /required/.  That means that, for instance,
           a 'vGetChar' after a 'vGetContents' may return some undefined
           result instead of the error you would normally get.  You should
           use caution to make sure your code doesn't fall into that trap,
           or make sure to test your code with Handle or one of the
           default instances defined in this module.  Also, some implementations
           may essentially provide a complete close after a call to 'vGetContents'.
           The bottom line: after a call to 'vGetContents', you should do nothing
           else with the object save closing it with 'vClose'.

           For implementators, you are highly encouraged to provide a correct
           implementation. -}
        vGetContents :: a -> IO String
        -- | Indicate whether at least one item is ready for reading.
        -- This will always be True for a great many implementations.
        vReady :: a -> IO Bool
        -- | Indicate whether a particular item is available for reading.
        vIsReadable :: a -> IO Bool

        -- | Write one character
        vPutChar :: a -> Char -> IO ()
        -- | Write a string
        vPutStr :: a -> String -> IO ()
        -- | Write a string with newline character after it
        vPutStrLn :: a -> String -> IO ()
        -- | Write a string representation of the argument, plus a newline.
        vPrint :: Show b => a -> b -> IO ()
        -- | Flush any output buffers.
        -- Note: implementations should assure that a vFlush is automatically
        -- performed
        -- on file close, if necessary to ensure all data sent is written.
        vFlush :: a -> IO ()
        -- | Indicate whether or not this particular object supports writing.
        vIsWritable :: a -> IO Bool

        -- | Seek to a specific location.
        vSeek :: a -> SeekMode -> Integer -> IO ()

        -- | Get the current position.
        vTell :: a -> IO Integer

        -- | Convenience function to reset the file pointer to the beginning
        -- of the file.  A call to @vRewind h@ is the
        -- same as @'vSeek' h AbsoluteSeek 0@.
        vRewind :: a -> IO ()

        -- | Indicate whether this instance supports seeking.
        vIsSeekable :: a -> IO Bool

        -- | Set buffering; the default action is a no-op.
        vSetBuffering :: a -> BufferMode -> IO ()

        -- | 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 a
    _ BufferMode
    _ = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        vGetBuffering a
    _ = BufferMode -> IO BufferMode
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return BufferMode
    NoBuffering

        vShow a
    x = String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> String
    forall a. Show a => a -> String
    show a
    x)

        vMkIOError a
    _ IOErrorType
    et String
    desc Maybe String
    mfp =
            IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
    mkIOError IOErrorType
    et String
    desc Maybe Handle
    forall a. Maybe a
    Nothing Maybe String
    mfp

        vGetFP a
    _ = Maybe String -> IO (Maybe String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe String
    forall a. Maybe a
    Nothing

        vThrow a
    h IOErrorType
    et = do
                      fp <- a -> IO (Maybe String)
    forall a. HVIO a => a -> IO (Maybe String)
    vGetFP a
    h
                      ioError (vMkIOError h et "" fp)

        vTestEOF a
    h = do e <- a -> IO Bool
    forall a. HVIO a => a -> IO Bool
    vIsEOF a
    h
                        if e then vThrow h eofErrorType
                           else return ()

        vIsOpen a
    h = a -> IO Bool
    forall a. HVIO a => a -> IO Bool
    vIsClosed a
    h IO Bool -> (Bool -> IO Bool) -> IO Bool
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> IO Bool) -> (Bool -> Bool) -> Bool -> IO Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> Bool
    not
        vIsClosed a
    h = a -> IO Bool
    forall a. HVIO a => a -> IO Bool
    vIsOpen a
    h IO Bool -> (Bool -> IO Bool) -> IO Bool
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> IO Bool) -> (Bool -> Bool) -> Bool -> IO Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> Bool
    not
        vTestOpen a
    h = do e <- a -> IO Bool
    forall a. HVIO a => a -> IO Bool
    vIsClosed a
    h
                         if e then vThrow h illegalOperationErrorType
                            else return ()

        vIsReadable a
    _ = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

        vGetLine a
    h =
            let loop :: String -> IO String
    loop String
    accum =
                    let func :: IO String
    func = do c <- a -> IO Char
    forall a. HVIO a => a -> IO Char
    vGetChar a
    h
                                  case c of
                                         Char
    '\n' -> String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    accum
                                         Char
    x    -> String
    accum String -> IO String -> IO String
    forall a b. a -> b -> b
    `seq` String -> IO String
    loop (String
    accum String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Char
    x])
                        handler :: IOError -> IO String
    handler IOError
    e = if IOError -> Bool
    isEOFError IOError
    e then String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    accum
                                    else IOError -> IO String
    forall a. IOError -> IO a
    ioError IOError
    e
                        in IO String -> (IOError -> IO String) -> IO String
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    Control.Exception.catch IO String
    func IOError -> IO String
    handler
                in
                do firstchar <- a -> IO Char
    forall a. HVIO a => a -> IO Char
    vGetChar a
    h
                   case firstchar of
                       Char
    '\n' -> String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
                       Char
    x    -> String -> IO String
    loop [Char
    x]

        vGetContents a
    h =
            let loop :: IO String
    loop =
                    let func :: IO String
    func = do c <- a -> IO Char
    forall a. HVIO a => a -> IO Char
    vGetChar a
    h
                                  next <- loop
                                  c `seq` return (c : next)
                        handler :: IOError -> IO [a]
    handler IOError
    e = if IOError -> Bool
    isEOFError IOError
    e then [a] -> IO [a]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
                                    else IOError -> IO [a]
    forall a. IOError -> IO a
    ioError IOError
    e
                        in IO String -> (IOError -> IO String) -> IO String
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    Control.Exception.catch IO String
    func IOError -> IO String
    forall {a}. IOError -> IO [a]
    handler
                in
                do loop

        vReady a
    h = do a -> IO ()
    forall a. HVIO a => a -> IO ()
    vTestEOF a
    h
                      Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True

        vIsWritable a
    _ = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

        vPutStr a
    _ [] = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        vPutStr a
    h (Char
    x:String
    xs) = do a -> Char -> IO ()
    forall a. HVIO a => a -> Char -> IO ()
    vPutChar a
    h Char
    x
                              a -> String -> IO ()
    forall a. HVIO a => a -> String -> IO ()
    vPutStr a
    h String
    xs

        vPutStrLn a
    h String
    s = a -> String -> IO ()
    forall a. HVIO a => a -> String -> IO ()
    vPutStr a
    h (String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n")

        vPrint a
    h b
    s = a -> String -> IO ()
    forall a. HVIO a => a -> String -> IO ()
    vPutStrLn a
    h (b -> String
    forall a. Show a => a -> String
    show b
    s)

        vFlush = a -> IO ()
    forall a. HVIO a => a -> IO ()
    vTestOpen

        vIsSeekable a
    _ = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

        vRewind a
    h = a -> SeekMode -> Integer -> IO ()
    forall a. HVIO a => a -> SeekMode -> Integer -> IO ()
    vSeek a
    h SeekMode
    AbsoluteSeek Integer
    0

        vPutChar a
    h Char
    _ = a -> IOErrorType -> IO ()
    forall b. a -> IOErrorType -> IO b
    forall a b. HVIO a => a -> IOErrorType -> IO b
    vThrow a
    h IOErrorType
    illegalOperationErrorType
        vSeek a
    h SeekMode
    _ Integer
    _ = a -> IOErrorType -> IO ()
    forall b. a -> IOErrorType -> IO b
    forall a b. HVIO a => a -> IOErrorType -> IO b
    vThrow a
    h IOErrorType
    illegalOperationErrorType
        vTell a
    h = a -> IOErrorType -> IO Integer
    forall b. a -> IOErrorType -> IO b
    forall a b. HVIO a => a -> IOErrorType -> IO b
    vThrow a
    h IOErrorType
    illegalOperationErrorType
        vGetChar a
    h = a -> IOErrorType -> IO Char
    forall b. a -> IOErrorType -> IO b
    forall a b. HVIO a => a -> IOErrorType -> IO b
    vThrow a
    h IOErrorType
    illegalOperationErrorType

        vPutBuf a
    h Ptr b
    buf Int
    len =
            do str <- CStringLen -> IO String
    peekCStringLen (Ptr b -> Ptr CChar
    forall a b. Ptr a -> Ptr b
    castPtr Ptr b
    buf, Int
    len)
               vPutStr h str

        vGetBuf a
    h Ptr b
    b Int
    l =
            Ptr b -> Int -> Int -> IO Int
    forall {t} {t} {b}. (Eq t, Num t, Num t) => Ptr b -> t -> t -> IO t
    worker Ptr b
    b Int
    l Int
    0
            where worker :: Ptr b -> t -> t -> IO t
    worker Ptr b
    _ t
    0 t
    accum = t -> IO t
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return t
    accum
                  worker Ptr b
    buf t
    len t
    accum =
                      do iseof <- a -> IO Bool
    forall a. HVIO a => a -> IO Bool
    vIsEOF a
    h
                         if iseof
                            then return accum
                            else do c <- vGetChar h
                                    let cc = Char -> CChar
    castCharToCChar Char
    c
                                    poke (castPtr buf) cc
                                    let newptr = Ptr b -> Int -> Ptr b
    forall a b. Ptr a -> Int -> Ptr b
    plusPtr Ptr b
    buf Int
    1
                                    worker newptr (len - 1) (accum + 1)

    ----------------------------------------------------------------------
    -- Handle instances
    ----------------------------------------------------------------------
    instance HVIO Handle where
        vClose :: Handle -> IO ()
    vClose = Handle -> IO ()
    hClose
        vIsEOF :: Handle -> IO Bool
    vIsEOF = Handle -> IO Bool
    hIsEOF
        vShow :: Handle -> IO String
    vShow = Handle -> IO String
    hShow
        vMkIOError :: Handle -> IOErrorType -> String -> Maybe String -> IOError
    vMkIOError Handle
    h IOErrorType
    et String
    desc Maybe String
    mfp =
            IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
    mkIOError IOErrorType
    et String
    desc (Handle -> Maybe Handle
    forall a. a -> Maybe a
    Just Handle
    h) Maybe String
    mfp
        vGetChar :: Handle -> IO Char
    vGetChar = Handle -> IO Char
    hGetChar
        vGetLine :: Handle -> IO String
    vGetLine = Handle -> IO String
    hGetLine
        vGetContents :: Handle -> IO String
    vGetContents = Handle -> IO String
    hGetContents
        vReady :: Handle -> IO Bool
    vReady = Handle -> IO Bool
    hReady
        vIsReadable :: Handle -> IO Bool
    vIsReadable = Handle -> IO Bool
    hIsReadable
        vPutChar :: Handle -> Char -> IO ()
    vPutChar = Handle -> Char -> IO ()
    hPutChar
        vPutStr :: Handle -> String -> IO ()
    vPutStr = Handle -> String -> IO ()
    hPutStr
        vPutStrLn :: Handle -> String -> IO ()
    vPutStrLn = Handle -> String -> IO ()
    hPutStrLn
        vPrint :: forall b. Show b => Handle -> b -> IO ()
    vPrint = Handle -> b -> IO ()
    forall b. Show b => Handle -> b -> IO ()
    hPrint
        vFlush :: Handle -> IO ()
    vFlush = Handle -> IO ()
    hFlush
        vIsWritable :: Handle -> IO Bool
    vIsWritable = Handle -> IO Bool
    hIsWritable
        vSeek :: Handle -> SeekMode -> Integer -> IO ()
    vSeek = Handle -> SeekMode -> Integer -> IO ()
    hSeek
        vTell :: Handle -> IO Integer
    vTell = Handle -> IO Integer
    hTell
        vIsSeekable :: Handle -> IO Bool
    vIsSeekable = Handle -> IO Bool
    hIsSeekable
        vSetBuffering :: Handle -> BufferMode -> IO ()
    vSetBuffering = Handle -> BufferMode -> IO ()
    hSetBuffering
        vGetBuffering :: Handle -> IO BufferMode
    vGetBuffering = Handle -> IO BufferMode
    hGetBuffering
        vGetBuf :: forall b. Handle -> Ptr b -> Int -> IO Int
    vGetBuf = Handle -> Ptr b -> Int -> IO Int
    forall b. Handle -> Ptr b -> Int -> IO Int
    hGetBuf
        vPutBuf :: forall b. Handle -> Ptr b -> Int -> IO ()
    vPutBuf = Handle -> Ptr b -> Int -> IO ()
    forall b. Handle -> Ptr b -> Int -> IO ()
    hPutBuf
        vIsOpen :: Handle -> IO Bool
    vIsOpen = Handle -> IO Bool
    hIsOpen
        vIsClosed :: Handle -> IO Bool
    vIsClosed = Handle -> IO Bool
    hIsClosed

    ----------------------------------------------------------------------
    -- VIO Support
    ----------------------------------------------------------------------
    type VIOCloseSupport a = IORef (Bool, a)

    vioc_isopen :: VIOCloseSupport a -> IO Bool
    vioc_isopen :: forall a. VIOCloseSupport a -> IO Bool
    vioc_isopen VIOCloseSupport a
    x = VIOCloseSupport a -> IO (Bool, a)
    forall a. IORef a -> IO a
    readIORef VIOCloseSupport a
    x IO (Bool, a) -> ((Bool, a) -> IO Bool) -> IO Bool
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> IO Bool) -> ((Bool, a) -> Bool) -> (Bool, a) -> IO Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Bool, a) -> Bool
    forall a b. (a, b) -> a
    fst

    vioc_get :: VIOCloseSupport a -> IO a
    vioc_get :: forall a. VIOCloseSupport a -> IO a
    vioc_get VIOCloseSupport a
    x = VIOCloseSupport a -> IO (Bool, a)
    forall a. IORef a -> IO a
    readIORef VIOCloseSupport a
    x IO (Bool, a) -> ((Bool, a) -> IO a) -> IO a
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> IO a) -> ((Bool, a) -> a) -> (Bool, a) -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Bool, a) -> a
    forall a b. (a, b) -> b
    snd

    vioc_close :: VIOCloseSupport a -> IO ()
    vioc_close :: forall a. VIOCloseSupport a -> IO ()
    vioc_close VIOCloseSupport a
    x = VIOCloseSupport a -> ((Bool, a) -> (Bool, a)) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef VIOCloseSupport a
    x (\ (Bool
    _, a
    dat) -> (Bool
    False, a
    dat))

    vioc_set :: VIOCloseSupport a -> a -> IO ()
    vioc_set :: forall a. VIOCloseSupport a -> a -> IO ()
    vioc_set VIOCloseSupport a
    x a
    newdat = VIOCloseSupport a -> ((Bool, a) -> (Bool, a)) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef VIOCloseSupport a
    x (\ (Bool
    stat, a
    _) -> (Bool
    stat, a
    newdat))

    ----------------------------------------------------------------------
    -- Stream Readers
    ----------------------------------------------------------------------
    {- | Simulate I\/O based on a string buffer.

    When a 'StreamReader' is created, it is initialized based on the contents of
    a 'String'.  Its contents are read lazily whenever a request is made to read
    something from the 'StreamReader'.    It
    can be used, therefore, to implement filters (simply initialize it with the
    result from, say, a map over hGetContents from another HVIO object), codecs,
    and simple I\/O testing.  Because it is lazy, it need not hold the entire
    string in memory.  You can create a 'StreamReader' with a call to
    'newStreamReader'.
     -}
    newtype StreamReader = StreamReader (VIOCloseSupport String)

    {- | Create a new 'StreamReader' object. -}
    newStreamReader :: String            -- ^ Initial contents of the 'StreamReader'
                    -> IO StreamReader
    newStreamReader :: String -> IO StreamReader
    newStreamReader String
    s = do ref <- (Bool, String) -> IO (IORef (Bool, String))
    forall a. a -> IO (IORef a)
    newIORef (Bool
    True, String
    s)
                           return (StreamReader ref)

    srv :: StreamReader -> VIOCloseSupport String
    srv :: StreamReader -> IORef (Bool, String)
    srv (StreamReader IORef (Bool, String)
    x) = IORef (Bool, String)
    x

    instance Show StreamReader where
        show :: StreamReader -> String
    show StreamReader
    _ = String
    "<StreamReader>"

    instance HVIO StreamReader where
        vClose :: StreamReader -> IO ()
    vClose = IORef (Bool, String) -> IO ()
    forall a. VIOCloseSupport a -> IO ()
    vioc_close (IORef (Bool, String) -> IO ())
    -> (StreamReader -> IORef (Bool, String)) -> StreamReader -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StreamReader -> IORef (Bool, String)
    srv
        vIsEOF :: StreamReader -> IO Bool
    vIsEOF StreamReader
    h = do StreamReader -> IO ()
    forall a. HVIO a => a -> IO ()
    vTestOpen StreamReader
    h
                      d <- IORef (Bool, String) -> IO String
    forall a. VIOCloseSupport a -> IO a
    vioc_get (StreamReader -> IORef (Bool, String)
    srv StreamReader
    h)
                      return $ case d of
                                      [] -> Bool
    True
                                      String
    _  -> Bool
    False
        vIsOpen :: StreamReader -> IO Bool
    vIsOpen = IORef (Bool, String) -> IO Bool
    forall a. VIOCloseSupport a -> IO Bool
    vioc_isopen (IORef (Bool, String) -> IO Bool)
    -> (StreamReader -> IORef (Bool, String))
    -> StreamReader
    -> IO Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StreamReader -> IORef (Bool, String)
    srv
        vGetChar :: StreamReader -> IO Char
    vGetChar StreamReader
    h = do StreamReader -> IO ()
    forall a. HVIO a => a -> IO ()
    vTestEOF StreamReader
    h
                        c <- IORef (Bool, String) -> IO String
    forall a. VIOCloseSupport a -> IO a
    vioc_get (StreamReader -> IORef (Bool, String)
    srv StreamReader
    h)
                        let retval = String -> Char
    forall a. HasCallStack => [a] -> a
    head String
    c
                        vioc_set (srv h) (tail c)
                        return retval

        vGetContents :: StreamReader -> IO String
    vGetContents StreamReader
    h = do StreamReader -> IO ()
    forall a. HVIO a => a -> IO ()
    vTestEOF StreamReader
    h
                            c <- IORef (Bool, String) -> IO String
    forall a. VIOCloseSupport a -> IO a
    vioc_get (StreamReader -> IORef (Bool, String)
    srv StreamReader
    h)
                            vClose h
                            return c
        vIsReadable :: StreamReader -> IO Bool
    vIsReadable StreamReader
    _ = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True

    ----------------------------------------------------------------------
    -- Buffers
    ----------------------------------------------------------------------
    {- | A 'MemoryBuffer' simulates true I\/O, but uses an in-memory buffer instead
    of on-disk storage.

    It provides
    a full interface like Handle (it implements 'HVIOReader', 'HVIOWriter',
    and 'HVIOSeeker').  However, it maintains an in-memory buffer with the
    contents of the file, rather than an actual on-disk file.  You can access
    the entire contents of this buffer at any time.  This can be quite useful
    for testing I\/O code, or for cases where existing APIs use I\/O, but you
    prefer a String representation.  You can create a 'MemoryBuffer' with a call
    to 'newMemoryBuffer'.

    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.
    -}
    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.

    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               -- ^ Initial Contents
                    -> (String -> IO ())    -- ^ close func
                    -> IO MemoryBuffer
    newMemoryBuffer :: String -> (String -> IO ()) -> IO MemoryBuffer
    newMemoryBuffer String
    initval String -> IO ()
    closefunc = do ref <- (Bool, (Int, String)) -> IO (IORef (Bool, (Int, String)))
    forall a. a -> IO (IORef a)
    newIORef (Bool
    True, (Int
    0, String
    initval))
                                           return (MemoryBuffer closefunc ref)

    {- | Default (no-op) memory buf close function. -}
    mbDefaultCloseFunc :: String -> IO ()
    mbDefaultCloseFunc :: String -> IO ()
    mbDefaultCloseFunc String
    _ = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    vrv :: MemoryBuffer -> VIOCloseSupport (Int, String)
    vrv :: MemoryBuffer -> IORef (Bool, (Int, String))
    vrv (MemoryBuffer String -> IO ()
    _ IORef (Bool, (Int, String))
    x) = IORef (Bool, (Int, String))
    x

    {- | Grab the entire contents of the buffer as a string.
    Unlike 'vGetContents', this has no effect on the open status of the
    item, the EOF status, or the current position of the file pointer. -}
    getMemoryBuffer :: MemoryBuffer -> IO String
    getMemoryBuffer :: MemoryBuffer -> IO String
    getMemoryBuffer MemoryBuffer
    h = do c <- IORef (Bool, (Int, String)) -> IO (Int, String)
    forall a. VIOCloseSupport a -> IO a
    vioc_get (MemoryBuffer -> IORef (Bool, (Int, String))
    vrv MemoryBuffer
    h)
                           return (snd c)

    instance Show MemoryBuffer where
        show :: MemoryBuffer -> String
    show MemoryBuffer
    _ = String
    "<MemoryBuffer>"

    instance HVIO MemoryBuffer where
        vClose :: MemoryBuffer -> IO ()
    vClose MemoryBuffer
    x = do wasopen <- MemoryBuffer -> IO Bool
    forall a. HVIO a => a -> IO Bool
    vIsOpen MemoryBuffer
    x
                      vioc_close (vrv x)
                      if wasopen
                         then do c <- getMemoryBuffer x
                                 case x of
                                     MemoryBuffer String -> IO ()
    cf IORef (Bool, (Int, String))
    _ -> String -> IO ()
    cf String
    c
                         else return ()
        vIsEOF :: MemoryBuffer -> IO Bool
    vIsEOF MemoryBuffer
    h = do MemoryBuffer -> IO ()
    forall a. HVIO a => a -> IO ()
    vTestOpen MemoryBuffer
    h
                      c <- IORef (Bool, (Int, String)) -> IO (Int, String)
    forall a. VIOCloseSupport a -> IO a
    vioc_get (MemoryBuffer -> IORef (Bool, (Int, String))
    vrv MemoryBuffer
    h)
                      return ((length (snd c)) == (fst c))
        vIsOpen :: MemoryBuffer -> IO Bool
    vIsOpen = IORef (Bool, (Int, String)) -> IO Bool
    forall a. VIOCloseSupport a -> IO Bool
    vioc_isopen (IORef (Bool, (Int, String)) -> IO Bool)
    -> (MemoryBuffer -> IORef (Bool, (Int, String)))
    -> MemoryBuffer
    -> IO Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MemoryBuffer -> IORef (Bool, (Int, String))
    vrv
        vGetChar :: MemoryBuffer -> IO Char
    vGetChar MemoryBuffer
    h = do MemoryBuffer -> IO ()
    forall a. HVIO a => a -> IO ()
    vTestEOF MemoryBuffer
    h
                        c <- IORef (Bool, (Int, String)) -> IO (Int, String)
    forall a. VIOCloseSupport a -> IO a
    vioc_get (MemoryBuffer -> IORef (Bool, (Int, String))
    vrv MemoryBuffer
    h)
                        let retval = ((Int, String) -> String
    forall a b. (a, b) -> b
    snd (Int, String)
    c) String -> Int -> Char
    forall a. HasCallStack => [a] -> Int -> a
    !! ((Int, String) -> Int
    forall a b. (a, b) -> a
    fst (Int, String)
    c)
                        vioc_set (vrv h) (succ (fst c), snd c)
                        return retval
        vGetContents :: MemoryBuffer -> IO String
    vGetContents MemoryBuffer
    h = do MemoryBuffer -> IO ()
    forall a. HVIO a => a -> IO ()
    vTestEOF MemoryBuffer
    h
                            v <- IORef (Bool, (Int, String)) -> IO (Int, String)
    forall a. VIOCloseSupport a -> IO a
    vioc_get (MemoryBuffer -> IORef (Bool, (Int, String))
    vrv MemoryBuffer
    h)
                            let retval = Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop ((Int, String) -> Int
    forall a b. (a, b) -> a
    fst (Int, String)
    v) ((Int, String) -> String
    forall a b. (a, b) -> b
    snd (Int, String)
    v)
                            vioc_set (vrv h) (-1, "")
                            vClose h
                            return retval
        vIsReadable :: MemoryBuffer -> IO Bool
    vIsReadable MemoryBuffer
    _ = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True

        vPutStr :: MemoryBuffer -> String -> IO ()
    vPutStr MemoryBuffer
    h String
    s = do (pos, buf) <- IORef (Bool, (Int, String)) -> IO (Int, String)
    forall a. VIOCloseSupport a -> IO a
    vioc_get (MemoryBuffer -> IORef (Bool, (Int, String))
    vrv MemoryBuffer
    h)
                         let (pre, post) = splitAt pos buf
                         let newbuf = String
    pre String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    s) String
    post)
                         vioc_set (vrv h) (pos + (length s), newbuf)
        vPutChar :: MemoryBuffer -> Char -> IO ()
    vPutChar MemoryBuffer
    h Char
    c = MemoryBuffer -> String -> IO ()
    forall a. HVIO a => a -> String -> IO ()
    vPutStr MemoryBuffer
    h [Char
    c]
        vIsWritable :: MemoryBuffer -> IO Bool
    vIsWritable MemoryBuffer
    _ = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
        vTell :: MemoryBuffer -> IO Integer
    vTell MemoryBuffer
    h = do v <- IORef (Bool, (Int, String)) -> IO (Int, String)
    forall a. VIOCloseSupport a -> IO a
    vioc_get (MemoryBuffer -> IORef (Bool, (Int, String))
    vrv MemoryBuffer
    h)
                     return . fromIntegral $ (fst v)
        vSeek :: MemoryBuffer -> SeekMode -> Integer -> IO ()
    vSeek MemoryBuffer
    h SeekMode
    seekmode Integer
    seekposp =
            do (pos, buf) <- IORef (Bool, (Int, String)) -> IO (Int, String)
    forall a. VIOCloseSupport a -> IO a
    vioc_get (MemoryBuffer -> IORef (Bool, (Int, String))
    vrv MemoryBuffer
    h)
               let seekpos = Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    seekposp
               let newpos = case SeekMode
    seekmode of
                                 SeekMode
    AbsoluteSeek -> Int
    seekpos
                                 SeekMode
    RelativeSeek -> Int
    pos Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    seekpos
                                 SeekMode
    SeekFromEnd  -> (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    buf) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    seekpos
               let buf2 = String
    buf String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ if Int
    newpos Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    buf)
                                    then Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    newpos Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    buf)) Char
    '\0'
                                    else []
               vioc_set (vrv h) (newpos, buf2)
        vIsSeekable :: MemoryBuffer -> IO Bool
    vIsSeekable MemoryBuffer
    _ = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True

    ----------------------------------------------------------------------
    -- Pipes
    ----------------------------------------------------------------------
    {- | Create a Haskell pipe.

    These pipes are analogous to the Unix
    pipes that are available from System.Posix, but don't require Unix and work
    only in Haskell.  When you create a pipe, you actually get two HVIO objects:
    a 'PipeReader' and a 'PipeWriter'.  You must use the 'PipeWriter' in one
    thread and the 'PipeReader' in another thread.  Data that's written to the
    'PipeWriter' will then be available for reading with the 'PipeReader'.  The
    pipes are implemented completely with existing Haskell threading primitives,
    and require no special operating system support.  Unlike Unix pipes, these
    pipes cannot be used across a fork().  Also unlike Unix pipes, these pipes
    are portable and interact well with Haskell threads. -}
    newHVIOPipe :: IO (PipeReader, PipeWriter)
    newHVIOPipe :: IO (PipeReader, PipeWriter)
    newHVIOPipe = do mv <- IO (MVar PipeBit)
    forall a. IO (MVar a)
    newEmptyMVar
                     readerref <- newIORef (True, mv)
                     let reader = IORef (Bool, MVar PipeBit) -> PipeReader
    PipeReader IORef (Bool, MVar PipeBit)
    readerref
                     writerref <- newIORef (True, reader)
                     return (reader, PipeWriter writerref)

    data PipeBit = PipeBit Char
                 | PipeEOF
                   deriving (PipeBit -> PipeBit -> Bool
    (PipeBit -> PipeBit -> Bool)
    -> (PipeBit -> PipeBit -> Bool) -> Eq PipeBit
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: PipeBit -> PipeBit -> Bool
    == :: PipeBit -> PipeBit -> Bool
    $c/= :: PipeBit -> PipeBit -> Bool
    /= :: PipeBit -> PipeBit -> Bool
    Eq, Int -> PipeBit -> String -> String
    [PipeBit] -> String -> String
    PipeBit -> String
    (Int -> PipeBit -> String -> String)
    -> (PipeBit -> String)
    -> ([PipeBit] -> String -> String)
    -> Show PipeBit
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> PipeBit -> String -> String
    showsPrec :: Int -> PipeBit -> String -> String
    $cshow :: PipeBit -> String
    show :: PipeBit -> String
    $cshowList :: [PipeBit] -> String -> String
    showList :: [PipeBit] -> String -> String
    Show)

    {- | The reading side of a Haskell pipe.  Please see 'newHVIOPipe' for more
    details. -}
    newtype PipeReader = PipeReader (VIOCloseSupport (MVar PipeBit))

    {- | The writing side of a Haskell pipe.  Please see 'newHVIOPipe' for more
    details. -}
    newtype PipeWriter = PipeWriter (VIOCloseSupport PipeReader)

    ------------------------------
    -- Pipe Reader
    ------------------------------
    prv :: PipeReader -> VIOCloseSupport (MVar PipeBit)
    prv :: PipeReader -> IORef (Bool, MVar PipeBit)
    prv (PipeReader IORef (Bool, MVar PipeBit)
    x) = IORef (Bool, MVar PipeBit)
    x

    instance Show PipeReader where
        show :: PipeReader -> String
    show PipeReader
    _ = String
    "<PipeReader>"

    pr_getc :: PipeReader -> IO PipeBit
    pr_getc :: PipeReader -> IO PipeBit
    pr_getc PipeReader
    h = do mv <- IORef (Bool, MVar PipeBit) -> IO (MVar PipeBit)
    forall a. VIOCloseSupport a -> IO a
    vioc_get (PipeReader -> IORef (Bool, MVar PipeBit)
    prv PipeReader
    h)
                   takeMVar mv

    instance HVIO PipeReader where
        vClose :: PipeReader -> IO ()
    vClose = IORef (Bool, MVar PipeBit) -> IO ()
    forall a. VIOCloseSupport a -> IO ()
    vioc_close (IORef (Bool, MVar PipeBit) -> IO ())
    -> (PipeReader -> IORef (Bool, MVar PipeBit))
    -> PipeReader
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PipeReader -> IORef (Bool, MVar PipeBit)
    prv
        vIsOpen :: PipeReader -> IO Bool
    vIsOpen = IORef (Bool, MVar PipeBit) -> IO Bool
    forall a. VIOCloseSupport a -> IO Bool
    vioc_isopen (IORef (Bool, MVar PipeBit) -> IO Bool)
    -> (PipeReader -> IORef (Bool, MVar PipeBit))
    -> PipeReader
    -> IO Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PipeReader -> IORef (Bool, MVar PipeBit)
    prv
        vIsEOF :: PipeReader -> IO Bool
    vIsEOF PipeReader
    h = do PipeReader -> IO ()
    forall a. HVIO a => a -> IO ()
    vTestOpen PipeReader
    h
                      mv <- IORef (Bool, MVar PipeBit) -> IO (MVar PipeBit)
    forall a. VIOCloseSupport a -> IO a
    vioc_get (PipeReader -> IORef (Bool, MVar PipeBit)
    prv PipeReader
    h)
                      dat <- readMVar mv
                      return (dat == PipeEOF)

        vGetChar :: PipeReader -> IO Char
    vGetChar PipeReader
    h = do PipeReader -> IO ()
    forall a. HVIO a => a -> IO ()
    vTestEOF PipeReader
    h
                        c <- PipeReader -> IO PipeBit
    pr_getc PipeReader
    h
                        case c of
                            PipeBit Char
    x -> Char -> IO Char
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Char
    x
                            -- vTestEOF should eliminate this case
                            PipeBit
    _ -> String -> IO Char
    forall a. String -> IO a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Internal error in HVIOReader vGetChar"
        vGetContents :: PipeReader -> IO String
    vGetContents PipeReader
    h =
            let loop :: IO String
    loop = do c <- PipeReader -> IO PipeBit
    pr_getc PipeReader
    h
                          case c of
                              PipeBit
    PipeEOF -> String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
                              PipeBit Char
    x -> do next <- IO String
    loop
                                              return (x : next)
            in do PipeReader -> IO ()
    forall a. HVIO a => a -> IO ()
    vTestEOF PipeReader
    h
                  IO String
    loop
        vIsReadable :: PipeReader -> IO Bool
    vIsReadable PipeReader
    _ = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True

    ------------------------------
    -- Pipe Writer
    ------------------------------
    pwv :: PipeWriter -> VIOCloseSupport PipeReader
    pwv :: PipeWriter -> IORef (Bool, PipeReader)
    pwv (PipeWriter IORef (Bool, PipeReader)
    x) = IORef (Bool, PipeReader)
    x

    pwmv :: PipeWriter -> IO (MVar PipeBit)
    pwmv :: PipeWriter -> IO (MVar PipeBit)
    pwmv (PipeWriter IORef (Bool, PipeReader)
    x) = do mv1 <- IORef (Bool, PipeReader) -> IO PipeReader
    forall a. VIOCloseSupport a -> IO a
    vioc_get IORef (Bool, PipeReader)
    x
                             vioc_get (prv mv1)

    instance Show PipeWriter where
        show :: PipeWriter -> String
    show PipeWriter
    _ = String
    "<PipeWriter>"

    instance HVIO PipeWriter where
        vClose :: PipeWriter -> IO ()
    vClose PipeWriter
    h = do o <- PipeWriter -> IO Bool
    forall a. HVIO a => a -> IO Bool
    vIsOpen PipeWriter
    h
                      if o then do
                                mv <- pwmv h
                                putMVar mv PipeEOF
                                vioc_close (pwv h)
                         else return ()
        vIsOpen :: PipeWriter -> IO Bool
    vIsOpen = IORef (Bool, PipeReader) -> IO Bool
    forall a. VIOCloseSupport a -> IO Bool
    vioc_isopen (IORef (Bool, PipeReader) -> IO Bool)
    -> (PipeWriter -> IORef (Bool, PipeReader))
    -> PipeWriter
    -> IO Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PipeWriter -> IORef (Bool, PipeReader)
    pwv
        vIsEOF :: PipeWriter -> IO Bool
    vIsEOF PipeWriter
    h = do PipeWriter -> IO ()
    forall a. HVIO a => a -> IO ()
    vTestOpen PipeWriter
    h
                      Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

        -- FIXME: race condition below (could be closed after testing)
        vPutChar :: PipeWriter -> Char -> IO ()
    vPutChar PipeWriter
    h Char
    c = do PipeWriter -> IO ()
    forall a. HVIO a => a -> IO ()
    vTestOpen PipeWriter
    h
                          child <- IORef (Bool, PipeReader) -> IO PipeReader
    forall a. VIOCloseSupport a -> IO a
    vioc_get (PipeWriter -> IORef (Bool, PipeReader)
    pwv PipeWriter
    h)
                          copen <- vIsOpen child
                          if copen
                             then do mv <- pwmv h
                                     putMVar mv (PipeBit c)
                             else fail "PipeWriter: Couldn't write to pipe because child end is closed"
        vIsWritable :: PipeWriter -> IO Bool
    vIsWritable PipeWriter
    _ = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True