diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,7 +7,13 @@ This project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). -## [0.3.5.0] - 2020-??-?? +## [0.4.0.0] - 2022-12-08 + +- Add `writeMutableByteArray` +- In the 0.3.5.0 release, the major version was supposed to be bumped. + This is being done now instead. + +## [0.3.5.0] - 2021-07-02 - Breaking: Start using pattern synonyms for macros. - Add dedicated modules for peeking at structures. diff --git a/posix-api.cabal b/posix-api.cabal --- a/posix-api.cabal +++ b/posix-api.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: posix-api -version: 0.3.5.0 +version: 0.4.0.0 synopsis: posix bindings description: This library provides a very thin wrapper around POSIX APIs. It can be diff --git a/src-assertions/Assertion.hs b/src-assertions/Assertion.hs --- a/src-assertions/Assertion.hs +++ b/src-assertions/Assertion.hs @@ -3,6 +3,7 @@ module Assertion ( assertByteArrayPinned + , assertMutableByteArrayPinned , assertMutablePrimArrayPinned ) where @@ -16,8 +17,18 @@ then x else error "assertMutablePrimArrayPinned" +assertMutableByteArrayPinned :: PM.MutablePrimArray s a -> PM.MutablePrimArray s a +assertMutableByteArrayPinned x = if isMutableByteArrayPinned x + then x + else error "assertMutableByteArrayPinned" + isMutablePrimArrayPinned :: PM.MutablePrimArray s a -> Bool +{-# inline isMutablePrimArrayPinned #-} isMutablePrimArrayPinned (PM.MutablePrimArray marr#) = isTrue# (Exts.isMutableByteArrayPinned# marr#) + +isMutableByteArrayPinned :: PM.MutableByteArray s -> Bool +{-# inline isMutableByteArrayPinned #-} +isMutableByteArrayPinned (PM.MutableByteArray marr#) = isTrue# (Exts.isMutableByteArrayPinned# marr#) assertByteArrayPinned :: PM.ByteArray -> PM.ByteArray assertByteArrayPinned x = if PM.isByteArrayPinned x diff --git a/src-noassertions/Assertion.hs b/src-noassertions/Assertion.hs --- a/src-noassertions/Assertion.hs +++ b/src-noassertions/Assertion.hs @@ -1,5 +1,6 @@ module Assertion ( assertByteArrayPinned + , assertMutableByteArrayPinned , assertMutablePrimArrayPinned ) where @@ -7,6 +8,9 @@ assertMutablePrimArrayPinned :: PM.MutablePrimArray s a -> PM.MutablePrimArray s a assertMutablePrimArrayPinned = id + +assertMutableByteArrayPinned :: PM.MutableByteArray s -> PM.MutableByteArray s +assertMutableByteArrayPinned = id assertByteArrayPinned :: PM.ByteArray -> PM.ByteArray assertByteArrayPinned = id diff --git a/src/Posix/File.hs b/src/Posix/File.hs --- a/src/Posix/File.hs +++ b/src/Posix/File.hs @@ -14,6 +14,7 @@ , uninterruptibleOpen , uninterruptibleOpenMode , writeByteArray + , writeMutableByteArray , close , uninterruptibleClose , uninterruptibleErrorlessClose @@ -40,17 +41,18 @@ , Types.exclusive ) where -import Assertion (assertByteArrayPinned) +import Assertion (assertByteArrayPinned,assertMutableByteArrayPinned) import Data.Bits ((.&.),(.|.)) import Data.Primitive (ByteArray(..)) import Foreign.C.Error (Errno,getErrno) import Foreign.C.String.Managed (ManagedCString(..)) import Foreign.C.Types (CInt(..),CSize(..)) -import GHC.Exts (ByteArray#) +import GHC.Exts (ByteArray#,MutableByteArray#,RealWorld) import Posix.File.Types (CreationFlags(..),AccessMode(..),StatusFlags(..)) import Posix.File.Types (DescriptorFlags(..)) import System.Posix.Types (Fd(..),CSsize(..),CMode(..)) import Data.Bytes.Types (Bytes(Bytes)) +import Data.Primitive (MutableByteArray(MutableByteArray)) import qualified Posix.File.Types as Types @@ -79,6 +81,9 @@ foreign import ccall safe "HaskellPosix.h write_offset" c_safe_bytearray_write :: Fd -> ByteArray# -> Int -> CSize -> IO CSsize +foreign import ccall safe "HaskellPosix.h write_offset" + c_safe_mutablebytearray_write :: Fd -> MutableByteArray# RealWorld -> Int -> CSize -> IO CSsize + foreign import ccall unsafe "HaskellPosix.h open" c_unsafe_open :: ByteArray# -> CInt -> IO Fd @@ -148,7 +153,7 @@ -- | Wrapper for @write(2)@ that takes a byte array and an offset. -- The byte array does not need to be pinned. -uninterruptibleWriteByteArray :: +uninterruptibleWriteByteArray :: Fd -- ^ Socket -> ByteArray -- ^ Source byte array -> Int -- ^ Offset into source array @@ -159,8 +164,8 @@ -- | Wrapper for @write(2)@ that takes a byte array and an offset. -- Uses @safe@ FFI. The byte array must be pinned. -writeByteArray :: - Fd -- ^ Socket +writeByteArray :: + Fd -- ^ File descriptor -> ByteArray -- ^ Source byte array -> Int -- ^ Offset into source array -> CSize -- ^ Length in bytes @@ -168,6 +173,18 @@ writeByteArray !fd !buf0 !off !len = let !(ByteArray buf1) = assertByteArrayPinned buf0 in c_safe_bytearray_write fd buf1 off len >>= errorsFromSize + +-- | Variant of 'writeByteArray' that operates on mutable byte array. +-- Uses @safe@ FFI. The byte array must be pinned. +writeMutableByteArray :: + Fd -- ^ File descriptor + -> MutableByteArray RealWorld -- ^ Source byte array + -> Int -- ^ Offset into source array + -> CSize -- ^ Length in bytes + -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer +writeMutableByteArray !fd !buf0 !off !len = + let !(MutableByteArray buf1) = assertMutableByteArrayPinned buf0 + in c_safe_mutablebytearray_write fd buf1 off len >>= errorsFromSize errorsFromSize :: CSsize -> IO (Either Errno CSize) errorsFromSize r = if r > (-1) diff --git a/src/Posix/Socket.hs b/src/Posix/Socket.hs --- a/src/Posix/Socket.hs +++ b/src/Posix/Socket.hs @@ -1,4 +1,5 @@ {-# language BangPatterns #-} +{-# language CPP #-} {-# language DataKinds #-} {-# language DuplicateRecordFields #-} {-# language GADTSyntax #-} @@ -215,7 +216,7 @@ import Foreign.C.Types (CInt(..),CSize(..)) import Foreign.Ptr (nullPtr) import GHC.Exts (Ptr,RealWorld,ByteArray#,MutableByteArray#) -import GHC.Exts (Addr#,TYPE,RuntimeRep(UnliftedRep)) +import GHC.Exts (Addr#,TYPE) import GHC.Exts (ArrayArray#,MutableArrayArray#,Int(I#)) import GHC.Exts (shrinkMutableByteArray#,touch#) import Posix.Socket.Types (Family(..),Protocol(..),Type(..),SocketAddress(..)) @@ -225,6 +226,12 @@ import Posix.Socket.Types (AddressInfo) import System.Posix.Types (Fd(..),CSsize(..)) +#if MIN_VERSION_base(4,16,0) +import GHC.Exts (RuntimeRep(BoxedRep),Levity(Unlifted)) +#else +import GHC.Exts (RuntimeRep(UnliftedRep)) +#endif + import qualified Posix.File as F import qualified Posix.Socket.Types as PST import qualified Data.Primitive as PM @@ -770,7 +777,11 @@ touchLifted newBufs pure r +#if MIN_VERSION_base(4,16,0) +data UList (a :: TYPE ('BoxedRep 'Unlifted)) where +#else data UList (a :: TYPE 'UnliftedRep) where +#endif UNil :: UList a UCons :: a -> UList a -> UList a