{-# LANGUAGE Trustworthy #-} {- arch-tag: I/O utilities, binary tools Copyright (c) 2004-2011 John Goerzen All rights reserved. For license and copyright information, see the file LICENSE -} {- | Module : System.IO.Binary Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause Stability : provisional Portability: portable to platforms supporting binary I\/O This module provides various helpful utilities for dealing with binary input and output. You can use this module to deal with binary blocks of data as either Strings or lists of Word8. The BinaryConvertible class provides this abstraction. Wherever you see HVIO, you can transparently substite a regular Handle. This module can work with any HVIO object, however. See "System.IO.HVIO" for more details. Versions of MissingH prior 0.11.6 lacked the 'BinaryConvertible' class and worked only with Strings and Handles. Important note: /binary functions are not supported in all Haskell implementations/. Do not import or use this module unless you know you are using an implementation that supports them. At this time, here is the support status: * GHC 6.2 and above: yes * GHC 6.x, earlier versions: unknown * GHC 5.x: no * nhc98: no * Hugs: partial (maybe complete; needs more testing) Non-binary functions may be found in "System.IO". See also: "System.IO.BlockIO" Written by John Goerzen, jgoerzen\@complete.org -} module System.IO.Binary( -- * Support for different types of blocks BinaryConvertible(..), -- * Entire File\/Handle Utilities -- ** Opened Handle Data Copying hBlockCopy, blockCopy, -- ** Disk File Data Copying copyFileBlocksToFile, -- * Binary Single-Block I\/O hPutBufStr, putBufStr, hGetBufStr, getBufStr, hFullGetBufStr, fullGetBufStr, -- * Binary Multi-Block I\/O hGetBlocks, getBlocks, hFullGetBlocks, fullGetBlocks, -- * Lazy Interaction readBinaryFile, writeBinaryFile, -- ** Binary Block-based hBlockInteract, blockInteract, hFullBlockInteract, fullBlockInteract ) where import Data.Word (Word8()) import Foreign.C.String (peekCStringLen, withCString) import Foreign.C.Types (CChar()) import Foreign.ForeignPtr import Foreign.Marshal.Array (peekArray, withArray) import Foreign.Ptr import System.IO import System.IO.HVFS import System.IO.HVIO import System.IO.Unsafe (unsafeInterleaveIO) {- | Provides support for handling binary blocks with convenient types. This module provides implementations for Strings and for [Word8] (lists of Word8s). -} class (Eq a, Show a) => BinaryConvertible a where toBuf :: [a] -> (Ptr CChar -> IO c) -> IO c fromBuf :: Int -> (Ptr CChar -> IO Int) -> IO [a] instance BinaryConvertible Char where toBuf = withCString fromBuf len func = do fbuf <- mallocForeignPtrArray (len + 1) withForeignPtr fbuf handler where handler ptr = do bytesread <- func ptr peekCStringLen (ptr, bytesread) instance BinaryConvertible Word8 where toBuf hslist func = withArray hslist (\ptr -> func (castPtr ptr)) fromBuf len func = do (fbuf::(ForeignPtr Word8)) <- mallocForeignPtrArray (len + 1) withForeignPtr fbuf handler where handler ptr = do bytesread <- func (castPtr ptr) peekArray bytesread ptr -- ************************************************** -- Binary Files -- ************************************************** {- | As a wrapper around the standard function 'System.IO.hPutBuf', this function takes a standard Haskell 'String' instead of the far less convenient @Ptr a@. The entire contents of the string will be written as a binary buffer using 'hPutBuf'. The length of the output will be the length of the passed String or list. If it helps, you can thing of this function as being of type @Handle -> String -> IO ()@ -} hPutBufStr :: (HVIO a, BinaryConvertible b) => a -> [b] -> IO () hPutBufStr f s = toBuf s (\cs -> vPutBuf f cs (length s)) -- | An alias for 'hPutBufStr' 'stdout' putBufStr :: (BinaryConvertible b) => [b] -> IO () putBufStr = hPutBufStr stdout {- | Acts a wrapper around the standard function 'System.IO.hGetBuf', this function returns a standard Haskell String (or [Word8]) instead of modifying a 'Ptr a' buffer. The length is the maximum length to read and the semantice are the same as with 'hGetBuf'; namely, the empty string is returned with EOF is reached, and any given read may read fewer bytes than the given length. (Actually, it's a wrapper around 'System.IO.HVIO.vGetBuf') -} hGetBufStr :: (HVIO a, BinaryConvertible b) => a -> Int -> IO [b] hGetBufStr f count = fromBuf count (\buf -> vGetBuf f buf count) -- | An alias for 'hGetBufStr' 'stdin' getBufStr :: (BinaryConvertible b) => Int -> IO [b] getBufStr = hGetBufStr stdin {- | Like 'hGetBufStr', but guarantees that it will only return fewer than the requested number of bytes when EOF is encountered. -} hFullGetBufStr :: (HVIO a, BinaryConvertible b) => a -> Int -> IO [b] hFullGetBufStr _ 0 = return [] hFullGetBufStr f count = do thisstr <- hGetBufStr f count if thisstr == [] then return [] else do remainder <- hFullGetBufStr f (count - (length thisstr)) return (thisstr ++ remainder) -- | An alias for 'hFullGetBufStr' 'stdin' fullGetBufStr :: BinaryConvertible b => Int -> IO [b] fullGetBufStr = hFullGetBufStr stdin {- | Writes the list of blocks to the given file handle -- a wrapper around 'hPutBufStr'. Think of this function as: >Handle -> [String] -> IO () (You can use it that way) -} hPutBlocks :: (HVIO a, BinaryConvertible b) => a -> [[b]] -> IO () hPutBlocks _ [] = return () hPutBlocks h (x:xs) = do hPutBufStr h x hPutBlocks h xs {- | An alias for 'hPutBlocks' 'stdout' putBlocks :: (BinaryConvertible b) => [[b]] -> IO () putBlocks = hPutBlocks stdout -} {- | Returns a lazily-evaluated list of all blocks in the input file, as read by 'hGetBufStr'. There will be no 0-length block in this list. The list simply ends at EOF. -} hGetBlocks :: (HVIO a, BinaryConvertible b) => a -> Int -> IO [[b]] hGetBlocks = hGetBlocksUtil hGetBufStr -- | An alias for 'hGetBlocks' 'stdin' getBlocks :: BinaryConvertible b => Int -> IO [[b]] getBlocks = hGetBlocks stdin {- | Same as 'hGetBlocks', but using 'hFullGetBufStr' underneath. -} hFullGetBlocks :: (HVIO a, BinaryConvertible b) => a -> Int -> IO [[b]] hFullGetBlocks = hGetBlocksUtil hFullGetBufStr -- | An alias for 'hFullGetBlocks' 'stdin' fullGetBlocks :: BinaryConvertible b => Int -> IO [[b]] fullGetBlocks = hFullGetBlocks stdin hGetBlocksUtil :: (HVIO a, BinaryConvertible b) => (a -> Int -> IO [b]) -> a -> Int -> IO [[b]] hGetBlocksUtil readfunc h count = unsafeInterleaveIO $ do block <- readfunc h count if block == [] then return [] else do remainder <- hGetBlocksUtil readfunc h count return (block : remainder) {- | Binary block-based interaction. This is useful for scenarios that take binary blocks, manipulate them in some way, and then write them out. Take a look at 'hBlockCopy' for an example. The integer argument is the size of input binary blocks. This function uses 'hGetBlocks' internally. -} hBlockInteract :: (HVIO a, HVIO d, BinaryConvertible b, BinaryConvertible c) => Int -> a -> d -> ([[b]] -> [[c]]) -> IO () hBlockInteract = hBlockInteractUtil hGetBlocks -- | An alias for 'hBlockInteract' over 'stdin' and 'stdout' blockInteract :: (BinaryConvertible b, BinaryConvertible c) => Int -> ([[b]] -> [[c]]) -> IO () blockInteract x = hBlockInteract x stdin stdout {- | Same as 'hBlockInteract', but uses 'hFullGetBlocks' instead of 'hGetBlocks' internally. -} hFullBlockInteract :: (HVIO a, HVIO d, BinaryConvertible b, BinaryConvertible c) => Int -> a -> d -> ([[b]] -> [[c]]) -> IO () hFullBlockInteract = hBlockInteractUtil hFullGetBlocks -- | An alias for 'hFullBlockInteract' over 'stdin' and 'stdout' fullBlockInteract :: (BinaryConvertible b, BinaryConvertible c) => Int -> ([[b]] -> [[c]]) -> IO () fullBlockInteract x = hFullBlockInteract x stdin stdout hBlockInteractUtil :: (HVIO a, HVIO d, BinaryConvertible b, BinaryConvertible c) => (a -> Int -> IO [[b]]) -> Int -> a -> d -> ([[b]] -> [[c]]) -> IO () hBlockInteractUtil blockreader blocksize hin hout func = do blocks <- blockreader hin blocksize hPutBlocks hout (func blocks) {- | Copies everything from the input handle to the output handle using binary blocks of the given size. This was once the following beautiful implementation: > hBlockCopy bs hin hout = hBlockInteract bs hin hout id ('id' is the built-in Haskell function that just returns whatever is given to it) In more recent versions of MissingH, it uses a more optimized routine that avoids ever having to convert the binary buffer at all. -} hBlockCopy :: (HVIO a, HVIO b) => Int -> a -> b -> IO () hBlockCopy bs hin hout = do (fbuf::ForeignPtr CChar) <- mallocForeignPtrArray (bs + 1) withForeignPtr fbuf handler where handler ptr = do bytesread <- vGetBuf hin ptr bs if bytesread > 0 then do vPutBuf hout ptr bytesread handler ptr else return () {- | Copies from 'stdin' to 'stdout' using binary blocks of the given size. An alias for 'hBlockCopy' over 'stdin' and 'stdout' -} blockCopy :: Int -> IO () blockCopy bs = hBlockCopy bs stdin stdout {- | Copies one filename to another in binary mode. Please note that the Unix permission bits on the output file cannot be set due to a limitation of the Haskell 'System.IO.openBinaryFile' function. Therefore, you may need to adjust those bits after the copy yourself. This function is implemented using 'hBlockCopy' internally. -} copyFileBlocksToFile :: Int -> FilePath -> FilePath -> IO () copyFileBlocksToFile bs infn outfn = do hin <- openBinaryFile infn ReadMode hout <- openBinaryFile outfn WriteMode hBlockCopy bs hin hout hClose hin hClose hout return () {- | Like the built-in 'readFile', but opens the file in binary instead of text mode. -} readBinaryFile :: FilePath -> IO String readBinaryFile = vReadBinaryFile SystemFS {- | Same as 'readBinaryFile', but works with HVFS objects. -} vReadBinaryFile :: (HVFSOpenable a) => a -> FilePath -> IO String vReadBinaryFile fs fp = vOpenBinaryFile fs fp ReadMode >>= (\(HVFSOpenEncap h) -> vGetContents h) {- | Like the built-in 'writeFile', but opens the file in binary instead of text mode. -} writeBinaryFile :: FilePath -> String -> IO () writeBinaryFile = vWriteBinaryFile SystemFS {- | Like 'writeBinaryFile', but works on HVFS objects. -} vWriteBinaryFile :: (HVFSOpenable a) => a -> FilePath -> String -> IO () vWriteBinaryFile fs name str = do h <- vOpenBinaryFile fs name WriteMode case h of HVFSOpenEncap x -> do vPutStr x str vClose x