~qrpnxz/effectful-st: Add wrappers for ByteArray

2 files changed, 209 insertions(+), 0 deletions(-)

M effectful-st.cabal
A src/Effectful/ST/Primitive/ByteArray.hs

M effectful-st.cabal => effectful-st.cabal +1 -0

@@ 41,6 41,7 @@ library
   exposed-modules:
       Effectful.ST
     , Effectful.ST.Primitive.Array
+    , Effectful.ST.Primitive.ByteArray
     , Effectful.ST.Primitive.PrimVar
   build-depends:
       base >=4.13 && <4.18

A src/Effectful/ST/Primitive/ByteArray.hs => src/Effectful/ST/Primitive/ByteArray.hs +208 -0

@@ 0,0 1,208 @@
+-- SPDX-License-Identifier: CC0-1.0
+{-
+Each contributor licenses you to do everything with this work that
+would otherwise infringe any patent claims they can license or become
+able to license.
+-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE TypeApplications #-}
+module Effectful.ST.Primitive.ByteArray
+  ( P.ByteArray(..)
+  , P.MutableByteArray(..)
+  , newByteArray
+  , newPinnedByteArray
+  , newAlignedPinnedByteArray
+  , resizeMutableByteArray
+  , shrinkMutableByteArray
+  , readByteArray
+  , writeByteArray
+  , P.indexByteArray
+  , P.emptyByteArray
+  , P.byteArrayFromList
+  , P.byteArrayFromListN
+  , P.foldrByteArray
+  , P.compareByteArrays
+  , freezeByteArray
+  , thawByteArray
+  , P.runByteArray
+  , runByteArrayEff
+  , createByteArrayEff
+  , createPinnedByteArrayEff
+  , createAlignedPinnedByteArrayEff
+  , unsafeFreezeByteArray
+  , unsafeThawByteArray
+  , copyByteArray
+  , copyMutableByteArray
+  , copyByteArrayToPtr
+  , copyMutableByteArrayToPtr
+  , copyByteArrayToAddr
+  , copyMutableByteArrayToAddr
+  , copyPtrToMutableByteArray
+  , moveByteArray
+  , setByteArray
+  , fillByteArray
+  , P.cloneByteArray
+  , cloneMutableByteArray
+  , P.sizeofByteArray
+  , P.sizeofMutableByteArray
+  , getSizeofMutableByteArray
+  , P.sameMutableByteArray
+  , P.isByteArrayPinned
+  , P.isMutableByteArrayPinned
+  , P.byteArrayContents
+  , P.mutableByteArrayContents
+  ) where
+
+import Effectful ( type (:>), Eff )
+import Effectful.ST ( STE, stToSTE, runSTE )
+import qualified Data.Primitive as P
+import Data.Word
+
+newByteArray :: STE s :> es => Int -> Eff es (P.MutableByteArray s)
+-- ^ `P.newByteArray` wrapper.
+newByteArray n = stToSTE $ P.newByteArray n
+
+newPinnedByteArray :: STE s :> es => Int -> Eff es (P.MutableByteArray s)
+-- ^ `P.newPinnedByteArray` wrapper.
+newPinnedByteArray n = stToSTE $ P.newPinnedByteArray n
+
+newAlignedPinnedByteArray :: STE s :> es => Int -> Int -> Eff es (P.MutableByteArray s)
+-- ^ `P.newAlignedPinnedByteArray` wrapper.
+newAlignedPinnedByteArray n a = stToSTE $ P.newAlignedPinnedByteArray n a
+
+resizeMutableByteArray :: STE s :> es => P.MutableByteArray s -> Int -> Eff es (P.MutableByteArray s)
+-- ^ `P.resizeMutableByteArray` wrapper.
+resizeMutableByteArray arr n = stToSTE $ P.resizeMutableByteArray arr n
+
+shrinkMutableByteArray :: STE s :> es => P.MutableByteArray s -> Int -> Eff es ()
+-- ^ `P.shrinkMutableByteArray` wrapper.
+shrinkMutableByteArray arr n = stToSTE $ P.shrinkMutableByteArray arr n
+
+readByteArray :: (P.Prim a, STE s :> es) => P.MutableByteArray s -> Int -> Eff es a
+-- ^ `P.readByteArray` wrapper.
+readByteArray arr ix = stToSTE $ P.readByteArray arr ix
+
+writeByteArray :: (P.Prim a, STE s :> es) => P.MutableByteArray s -> Int -> a -> Eff es ()
+-- ^ `P.writeByteArray` wrapper.
+writeByteArray arr ix a = stToSTE $ P.writeByteArray arr ix a
+
+freezeByteArray :: STE s :> es => P.MutableByteArray s -> Int -> Int -> Eff es P.ByteArray
+-- ^ `P.freezeByteArray` wrapper.
+freezeByteArray arr off len = stToSTE $ P.freezeByteArray arr off len
+
+thawByteArray :: STE s :> es => P.ByteArray -> Int -> Int -> Eff es (P.MutableByteArray s)
+-- ^ `P.thawByteArray` wrapper.
+thawByteArray arr off len = stToSTE $ P.thawByteArray arr off len
+
+runByteArrayEff
+  :: (forall s. Eff (STE s : es) (P.MutableByteArray s))
+  -> Eff es P.ByteArray
+-- ^ `P.runArray`, but in `Eff`.
+runByteArrayEff m = runSTE $ unsafeFreezeByteArray =<< m
+
+createByteArrayEff
+  :: Int
+  -> (forall s. P.MutableByteArray s -> Eff (STE s : es) ())
+  -> Eff es P.ByteArray
+-- ^ `P.createByteArray` (if it existed), but in `Eff`.
+createByteArrayEff 0 _ = pure P.emptyByteArray
+createByteArrayEff n k = runByteArrayEff $ do
+  marr <- newByteArray n
+  k marr
+  pure marr
+
+createPinnedByteArrayEff
+  :: Int
+  -> (forall s. P.MutableByteArray s -> Eff (STE s : es) ())
+  -> Eff es P.ByteArray
+-- ^ `P.createPinnedByteArray` (if it existed), but in `Eff`.
+createPinnedByteArrayEff 0 _ = pure P.emptyByteArray
+createPinnedByteArrayEff n k = runByteArrayEff $ do
+  marr <- newPinnedByteArray n
+  k marr
+  pure marr
+
+createAlignedPinnedByteArrayEff
+  :: Int
+  -> Int
+  -> (forall s. P.MutableByteArray s -> Eff (STE s : es) ())
+  -> Eff es P.ByteArray
+-- ^ `P.createAlignedPinnedByteArray` (if it existed), but in `Eff`.
+createAlignedPinnedByteArrayEff 0 _ _ = pure P.emptyByteArray
+createAlignedPinnedByteArrayEff n a k = runByteArrayEff $ do
+  marr <- newAlignedPinnedByteArray n a
+  k marr
+  pure marr
+
+unsafeFreezeByteArray :: STE s :> es => P.MutableByteArray s -> Eff es P.ByteArray
+-- ^ `P.unsafeFreezeByteArray` wrapper.
+unsafeFreezeByteArray = stToSTE . P.unsafeFreezeByteArray
+
+unsafeThawByteArray :: STE s :> es => P.ByteArray -> Eff es (P.MutableByteArray s)
+-- ^ `P.unsafeThawByteArray` wrapper.
+unsafeThawByteArray = stToSTE . P.unsafeThawByteArray
+
+copyByteArray :: STE s :> es => P.MutableByteArray s -> Int -> P.ByteArray -> Int -> Int -> Eff es ()
+-- ^ `P.newArray` wrapper.
+copyByteArray marr doff arr off len = stToSTE $
+  P.copyByteArray marr doff arr off len
+
+copyMutableByteArray :: STE s :> es => P.MutableByteArray s -> Int -> P.MutableByteArray s -> Int -> Int -> Eff es ()
+-- ^ `P.copyMutableByteArray` wrapper.
+copyMutableByteArray marr doff arr off len = stToSTE $
+  P.copyMutableByteArray marr doff arr off len
+
+copyByteArrayToPtr :: forall s a es. (P.Prim a, STE s :> es) => P.Ptr a -> P.ByteArray -> Int -> Int -> Eff es ()
+-- ^ `P.copyByteArrayToPtr` wrapper.
+copyByteArrayToPtr ptr arr off len = stToSTE @s $
+  P.copyByteArrayToPtr ptr arr off len
+
+copyMutableByteArrayToPtr :: (P.Prim a, STE s :> es) => P.Ptr a -> P.MutableByteArray s -> Int -> Int -> Eff es ()
+-- ^ `P.copyMutableByteArrayToPtr` wrapper.
+copyMutableByteArrayToPtr ptr arr off len = stToSTE $
+  P.copyMutableByteArrayToPtr ptr arr off len
+
+copyByteArrayToAddr :: forall s es. STE s :> es => P.Ptr Word8 -> P.ByteArray -> Int -> Int -> Eff es ()
+-- ^ `P.copyByteArrayToAddr` wrapper.
+copyByteArrayToAddr ptr arr off len = stToSTE @s $
+  P.copyByteArrayToAddr ptr arr off len
+
+copyMutableByteArrayToAddr :: STE s :> es => P.Ptr Word8 -> P.MutableByteArray s -> Int -> Int -> Eff es ()
+-- ^ `P.copyMutableByteArrayToAddr` wrapper.
+copyMutableByteArrayToAddr ptr arr off len = stToSTE $
+  P.copyMutableByteArrayToAddr ptr arr off len
+
+copyPtrToMutableByteArray :: (P.Prim a, STE s :> es) => P.MutableByteArray s -> Int -> P.Ptr a -> Int -> Eff es ()
+-- ^ `P.copyPtrToMutableByteArray` wrapper.
+copyPtrToMutableByteArray arr doff ptr n = stToSTE $
+  P.copyPtrToMutableByteArray arr doff ptr n
+
+moveByteArray :: STE s :> es => P.MutableByteArray s -> Int -> P.MutableByteArray s -> Int -> Int -> Eff es ()
+-- ^ `P.moveByteArray` wrapper.
+moveByteArray marr doff arr off len = stToSTE $
+  P.moveByteArray marr doff arr off len
+
+setByteArray :: (P.Prim a, STE s :> es) => P.MutableByteArray s -> Int -> Int -> a -> Eff es ()
+-- ^ `P.setByteArray` wrapper.
+setByteArray arr off len a = stToSTE $
+  P.setByteArray arr off len a
+
+fillByteArray :: STE s :> es => P.MutableByteArray s -> Int -> Int -> Word8 -> Eff es ()
+-- ^ `P.fillByteArray` wrapper.
+fillByteArray arr off len word = stToSTE $
+  P.fillByteArray arr off len word
+
+cloneMutableByteArray :: STE s :> es => P.MutableByteArray s -> Int -> Int -> Eff es (P.MutableByteArray s)
+-- ^ `P.cloneMutableByteArray` wrapper.
+cloneMutableByteArray marr off len = stToSTE $
+  P.cloneMutableByteArray marr off len
+
+getSizeofMutableByteArray :: STE s :> es => P.MutableByteArray s -> Eff es Int
+-- ^ `P.getSizeofMutableByteArray` wrapper.
+getSizeofMutableByteArray = stToSTE . P.getSizeofMutableByteArray