Added implementation for hSetFileSize. The configure script checks
for _chsize (usially Windows) and ftruncate (Linux) C functions
and the package uses one of them to implement hSetFileSize.
stdin, stdout, stderr,
IOMode(..), openFile, openBinaryFile, openFd, fdToHandle,
stdin, stdout, stderr,
IOMode(..), openFile, openBinaryFile, openFd, fdToHandle,
- hFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
+ hFileSize, hSetFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
hFlush, hDuplicate, hDuplicateTo,
hClose, hClose_help,
hFlush, hDuplicate, hDuplicateTo,
hClose, hClose_help,
})
-----------------------------------------------------------------------------
})
-----------------------------------------------------------------------------
--- Detecting the size of a file
+-- Detecting and changing the size of a file
-- | For a handle @hdl@ which attached to a physical file,
-- 'hFileSize' @hdl@ returns the size of that file in 8-bit bytes.
-- | For a handle @hdl@ which attached to a physical file,
-- 'hFileSize' @hdl@ returns the size of that file in 8-bit bytes.
else ioException (IOError Nothing InappropriateType "hFileSize"
"not a regular file" Nothing)
else ioException (IOError Nothing InappropriateType "hFileSize"
"not a regular file" Nothing)
+
+-- | 'hSetFileSize' @hdl@ @size@ truncates the physical file with handle @hdl@ to @size@ bytes.
+
+hSetFileSize :: Handle -> Integer -> IO ()
+hSetFileSize handle size =
+ withHandle_ "hSetFileSize" handle $ \ handle_ -> do
+ case haType handle_ of
+ ClosedHandle -> ioe_closedHandle
+ SemiClosedHandle -> ioe_closedHandle
+ _ -> do flushWriteBufferOnly handle_
+ throwErrnoIf (/=0) "hSetFileSize"
+ (c_ftruncate (fromIntegral (haFD handle_)) (fromIntegral size))
+ return ()
+
-- ---------------------------------------------------------------------------
-- Detecting the End of Input
-- ---------------------------------------------------------------------------
-- Detecting the End of Input
-- * Operations on handles
-- * Operations on handles
- -- ** Determining the size of a file
+ -- ** Determining and changing the size of a file
hFileSize, -- :: Handle -> IO Integer
hFileSize, -- :: Handle -> IO Integer
+#ifdef __GLASGOW_HASKELL__
+ hSetFileSize, -- :: Handle -> Integer -> IO ()
+#endif
-- ** Detecting the end of input
-- ** Detecting the end of input
foreign import ccall unsafe "HsBase.h write"
c_write :: CInt -> Ptr CChar -> CSize -> IO CSsize
foreign import ccall unsafe "HsBase.h write"
c_write :: CInt -> Ptr CChar -> CSize -> IO CSsize
+foreign import ccall unsafe "HsBase.h __hscore_ftruncate"
+ c_ftruncate :: CInt -> COff -> IO CInt
+
foreign import ccall unsafe "HsBase.h unlink"
c_unlink :: CString -> IO CInt
foreign import ccall unsafe "HsBase.h unlink"
c_unlink :: CString -> IO CInt
AC_CHECK_FUNCS([ftime gmtime_r localtime_r lstat readdir_r])
AC_CHECK_FUNCS([ftime gmtime_r localtime_r lstat readdir_r])
+AC_CHECK_FUNCS([_chsize ftruncate])
+
# map standard C types and ISO types to Haskell types
FPTOOLS_CHECK_HTYPE(char)
FPTOOLS_CHECK_HTYPE(signed char)
# map standard C types and ISO types to Haskell types
FPTOOLS_CHECK_HTYPE(char)
FPTOOLS_CHECK_HTYPE(signed char)
+INLINE int
+__hscore_ftruncate( int fd, off_t where )
+{
+#if defined(HAVE_FTRUNCATE)
+ return ftruncate(fd,where);
+#elif defined(HAVE__CHSIZE)
+ return _chsize(fd,where);
+#else
+#error at least ftruncate or _chsize functions are required to build
+#endif
+}
+
INLINE HsInt
__hscore_setmode( HsInt fd, HsBool toBin )
{
INLINE HsInt
__hscore_setmode( HsInt fd, HsBool toBin )
{