--tmp
module Data.Array.IO (
IOArray,
IOUArray,
castIOUArray,
module Data.Array.MArray,
hGetArray,
hPutArray,
) where
import Data.Array.Base
import Data.Array.IO.Internals
import Data.Array.MArray
import System.IO.Error
#ifdef __GLASGOW_HASKELL__
import Foreign
import Foreign.C
import GHC.Exts (MutableByteArray#, RealWorld)
import GHC.Arr
import GHC.IORef
import GHC.IO.Handle
import GHC.IO.Buffer
import GHC.IO.Exception
#else
import Data.Char
import Data.Word ( Word8 )
import System.IO
#endif
#ifdef __GLASGOW_HASKELL__
hGetArray
:: Handle
-> IOUArray Int Word8
-> Int
-> IO Int
hGetArray handle (IOUArray (STUArray _l _u n ptr)) count
| count == 0 = return 0
| count < 0 || count > n = illegalBufferSize handle "hGetArray" count
| otherwise = do
allocaBytes n $ \p -> do
r <- hGetBuf handle p n
memcpy_ba_ptr ptr p (fromIntegral r)
return r
foreign import ccall unsafe "memcpy"
memcpy_ba_ptr :: MutableByteArray# RealWorld -> Ptr a -> CSize -> IO (Ptr ())
hPutArray
:: Handle
-> IOUArray Int Word8
-> Int
-> IO ()
hPutArray handle (IOUArray (STUArray _l _u n raw)) count
| count == 0 = return ()
| count < 0 || count > n = illegalBufferSize handle "hPutArray" count
| otherwise = do
allocaBytes n $ \p -> do
memcpy_ptr_ba p raw (fromIntegral n)
hPutBuf handle p n
foreign import ccall unsafe "memcpy"
memcpy_ptr_ba :: Ptr a -> MutableByteArray# RealWorld -> CSize -> IO (Ptr ())
illegalBufferSize :: Handle -> String -> Int -> IO a
illegalBufferSize handle fn sz =
ioException (ioeSetErrorString
(mkIOError InvalidArgument fn (Just handle) Nothing)
("illegal buffer size " ++ showsPrec 9 (sz::Int) []))
#else /* !__GLASGOW_HASKELL__ */
hGetArray :: Handle -> IOUArray Int Word8 -> Int -> IO Int
hGetArray handle arr count = do
bds <- getBounds arr
if count < 0 || count > rangeSize bds
then illegalBufferSize handle "hGetArray" count
else get 0
where
get i | i == count = return i
| otherwise = do
error_or_c <- try (hGetChar handle)
case error_or_c of
Left ex
| isEOFError ex -> return i
| otherwise -> ioError ex
Right c -> do
unsafeWrite arr i (fromIntegral (ord c))
get (i+1)
hPutArray :: Handle -> IOUArray Int Word8 -> Int -> IO ()
hPutArray handle arr count = do
bds <- getBounds arr
if count < 0 || count > rangeSize bds
then illegalBufferSize handle "hPutArray" count
else put 0
where
put i | i == count = return ()
| otherwise = do
w <- unsafeRead arr i
hPutChar handle (chr (fromIntegral w))
put (i+1)
illegalBufferSize :: Handle -> String -> Int -> IO a
illegalBufferSize _ fn sz = ioError $
userError (fn ++ ": illegal buffer size " ++ showsPrec 9 (sz::Int) [])
#endif /* !__GLASGOW_HASKELL__ */