Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

IOHasBufFS interface for I/O using user-supplied buffers #46

Merged
merged 1 commit into from
Mar 14, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion .stylish-haskell.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,7 @@ steps:
#
# # Should export lists be sorted? Sorting is only performed within the
# # export section, as delineated by Haddock comments.
sort: true
sort: false
#
# # See `separate_lists` for the `imports` step.
separate_lists: true
Expand Down
13 changes: 13 additions & 0 deletions fs-api/CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,19 @@

## next release -- ????-??-??

### Breaking

* New `primitive ^>=0.9` dependency

### Non-breaking

* Add new `HasBufFS` interface for performing I/O using buffers. Note that it is
likely that this interfaced is unified with the `HasFS` interface in the
future.
* Add compound functions, built from primitives in `HasBufFS`: `hGetAllAt`,
`hGetBufExactly`, `hPutBufExactly`, `hGetBufExactlyAt` and `hPutBufExactlyAt`
* Provide an instantiation of the `HasBufFS` interface for `IO`.

### Patch

* Make internal error comparison function more lenient on MacOS systems.
Expand Down
24 changes: 23 additions & 1 deletion fs-api/fs-api.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@ license-files:

copyright: 2019-2023 Input Output Global Inc (IOG)
author: IOG Engineering Team
maintainer: operations@iohk.io, Joris Dral
maintainer: operations@iohk.io, Joris Dral (joris@well-typed.com)
category: System
build-type: Simple
extra-doc-files: CHANGELOG.md
Expand Down Expand Up @@ -45,6 +45,7 @@ library
, directory >=1.3 && <1.4
, filepath >=1.4 && <1.5
, io-classes >=0.3 && <1.5
, primitive ^>=0.9
, text >=1.2 && <2.2

if os(windows)
Expand All @@ -69,3 +70,24 @@ library
-Wall -Wcompat -Wincomplete-uni-patterns
-Wincomplete-record-updates -Wpartial-fields -Widentities
-Wredundant-constraints -Wmissing-export-lists -Wunused-packages

test-suite fs-api-test
type: exitcode-stdio-1.0
hs-source-dirs: test
main-is: Main.hs
other-modules: Test.System.FS.IO
default-language: Haskell2010
build-depends:
, base
, bytestring
, fs-api
, primitive
, tasty
, tasty-quickcheck
, temporary

ghc-options:
-Wall -Wcompat -Wincomplete-uni-patterns
-Wincomplete-record-updates -Wpartial-fields -Widentities
-Wredundant-constraints -Wmissing-export-lists -Wunused-packages
-fno-ignore-asserts
29 changes: 26 additions & 3 deletions fs-api/src-unix/System/FS/IO/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,11 +9,15 @@ module System.FS.IO.Internal (
, getSize
, open
, pread
, preadBuf
, pwriteBuf
, read
, readBuf
, sameError
, seek
, truncate
, write
, writeBuf
) where

import Prelude hiding (read, truncate)
Expand All @@ -29,8 +33,9 @@ import System.FS.API.Types (AllowExisting (..), OpenMode (..),
import System.FS.IO.Internal.Error (sameError)
import System.FS.IO.Internal.Handle
import qualified System.Posix as Posix
import System.Posix (Fd)
import System.Posix.IO.ByteString.Ext (fdPreadBuf)
import System.Posix (ByteCount, Fd (..), FileOffset)
import qualified System.Posix.IO.ByteString.Ext as Posix (fdPreadBuf,
fdPwriteBuf)

type FHandle = HandleOS Fd

Expand Down Expand Up @@ -130,10 +135,28 @@ read h bytes = withOpenHandle "read" h $ \fd ->
Internal.createUptoN (fromIntegral bytes) $ \ptr ->
fromIntegral <$> Posix.fdReadBuf fd ptr (fromIntegral bytes)

readBuf :: FHandle -> Ptr Word8 -> ByteCount -> IO ByteCount
readBuf f buf c = withOpenHandle "readBuf" f $ \fd -> Posix.fdReadBuf fd buf c

writeBuf :: FHandle -> Ptr Word8 -> ByteCount -> IO ByteCount
writeBuf f buf c = withOpenHandle "writeBuf" f $ \fd -> Posix.fdWriteBuf fd buf c

pread :: FHandle -> Word64 -> Word64 -> IO ByteString
pread h bytes offset = withOpenHandle "pread" h $ \fd ->
Internal.createUptoN (fromIntegral bytes) $ \ptr ->
fromIntegral <$> fdPreadBuf fd ptr (fromIntegral bytes) (fromIntegral offset)
fromIntegral <$> Posix.fdPreadBuf fd ptr (fromIntegral bytes) (fromIntegral offset)

-- | @'preadBuf' fh buf c off@ reads @c@ bytes into the buffer @buf@ from the file
-- handle @fh@ at the file offset @off@. This does not move the position of the
-- file handle.
preadBuf :: FHandle -> Ptr Word8 -> ByteCount -> FileOffset -> IO ByteCount
preadBuf h buf c off = withOpenHandle "preadBuf" h $ \fd -> Posix.fdPreadBuf fd buf c off

-- | @'pwriteBuf' fh buf c off@ writes @c@ bytes from the data in the buffer
-- @buf@ to the file handle @fh@ at the file offset @off@. This does not move
-- the position of the file handle.
pwriteBuf :: FHandle -> Ptr Word8 -> ByteCount -> FileOffset -> IO ByteCount
pwriteBuf h buf c off = withOpenHandle "pwriteBuf" h $ \fd -> Posix.fdPwriteBuf fd buf c off

-- | Truncates the file managed by the input 'FHandle' to the input size.
truncate :: FHandle -> Word64 -> IO ()
Expand Down
29 changes: 29 additions & 0 deletions fs-api/src-win32/System/FS/IO/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,11 +8,15 @@ module System.FS.IO.Internal (
, getSize
, open
, pread
, preadBuf
, pwriteBuf
, read
, readBuf
, sameError
, seek
, truncate
, write
, writeBuf
) where

import Prelude hiding (read, truncate)
Expand All @@ -26,6 +30,7 @@ import Foreign (Int64, Ptr)
import System.FS.API.Types (AllowExisting (..), FsError (..),
FsErrorType (..), OpenMode (..), SeekMode (..))
import System.FS.IO.Internal.Handle
import System.Posix.Types
import System.Win32

type FHandle = HandleOS HANDLE
Expand Down Expand Up @@ -78,6 +83,14 @@ read fh bytes = withOpenHandle "read" fh $ \h ->
getCurrentFileOffset :: HANDLE -> IO Int64
getCurrentFileOffset h = setFilePointerEx h 0 fILE_CURRENT

readBuf :: FHandle -> Ptr Word8 -> ByteCount -> IO ByteCount
readBuf fh buf c = withOpenHandle "readBuf" fh $ \h ->
fromIntegral <$> win32_ReadFile h buf (fromIntegral c) Nothing

writeBuf :: FHandle -> Ptr Word8 -> ByteCount -> IO ByteCount
writeBuf fh buf c = withOpenHandle "writeBuf" fh $ \h ->
fromIntegral <$> win32_WriteFile h buf (fromIntegral c) Nothing

pread :: FHandle -> Word64 -> Word64 -> IO ByteString
pread fh bytes pos = withOpenHandle "pread" fh $ \h ->
Internal.createUptoN (fromIntegral bytes) $ \ptr -> do
Expand All @@ -87,6 +100,22 @@ pread fh bytes pos = withOpenHandle "pread" fh $ \h ->
_ <- setFilePointerEx h initialOffset fILE_BEGIN
return n

preadBuf :: FHandle -> Ptr Word8 -> ByteCount -> FileOffset -> IO ByteCount
preadBuf fh buf c off = withOpenHandle "preadBuf" fh $ \h -> do
initialOffset <- getCurrentFileOffset h
_ <- setFilePointerEx h (fromIntegral off) fILE_BEGIN
n <- fromIntegral <$> win32_ReadFile h buf (fromIntegral c) Nothing
_ <- setFilePointerEx h initialOffset fILE_BEGIN
return n

pwriteBuf :: FHandle -> Ptr Word8 -> ByteCount -> FileOffset -> IO ByteCount
pwriteBuf fh buf c off = withOpenHandle "pwriteBuf" fh $ \h -> do
initialOffset <- getCurrentFileOffset h
_ <- setFilePointerEx h (fromIntegral off) fILE_BEGIN
n <- fromIntegral <$> win32_WriteFile h buf (fromIntegral c) Nothing
_ <- setFilePointerEx h initialOffset fILE_BEGIN
return n

-- We only allow truncate in AppendMode, but Windows do not support it, so we manually seek to the end.
-- It is important that the logical end of the handle stays alligned to the physical end of the file.
truncate :: FHandle -> Word64 -> IO ()
Expand Down
Loading
Loading