module Extism.CurrentPlugin where

import Extism
import Extism.Bindings
import Data.Word
import Data.ByteString as B
import Foreign.Ptr
import Foreign.Marshal.Array

-- | Allocate a new handle of the given size
memoryAlloc :: CurrentPlugin -> Word64 -> IO Word64
memoryAlloc :: CurrentPlugin -> Word64 -> IO Word64
memoryAlloc = CurrentPlugin -> Word64 -> IO Word64
extism_current_plugin_memory_alloc

-- | Get the length of a handle, returns 0 if the handle is invalid
memoryLength :: CurrentPlugin -> Word64 -> IO Word64
memoryLength :: CurrentPlugin -> Word64 -> IO Word64
memoryLength = CurrentPlugin -> Word64 -> IO Word64
extism_current_plugin_memory_length

-- | Free allocated memory
memoryFree :: CurrentPlugin -> Word64 -> IO ()
memoryFree :: CurrentPlugin -> Word64 -> IO ()
memoryFree = CurrentPlugin -> Word64 -> IO ()
extism_current_plugin_memory_free

-- | Access a pointer to the entire memory region
memory :: CurrentPlugin -> IO (Ptr Word8)
memory :: CurrentPlugin -> IO (Ptr Word8)
memory = CurrentPlugin -> IO (Ptr Word8)
extism_current_plugin_memory

-- | Access a pointer the a specific offset in memory
memoryOffset :: CurrentPlugin -> Word64 -> IO (Ptr Word8)
memoryOffset :: CurrentPlugin -> Word64 -> IO (Ptr Word8)
memoryOffset CurrentPlugin
plugin Word64
offs = do
  Ptr Word8
x <- CurrentPlugin -> IO (Ptr Word8)
extism_current_plugin_memory CurrentPlugin
plugin
  Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
x (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
offs)

-- | Access the data associated with a handle as a 'ByteString'
memoryBytes :: CurrentPlugin -> Word64 ->  IO B.ByteString
memoryBytes :: CurrentPlugin -> Word64 -> IO ByteString
memoryBytes CurrentPlugin
plugin Word64
offs = do
  Ptr Word8
ptr <- CurrentPlugin -> Word64 -> IO (Ptr Word8)
memoryOffset CurrentPlugin
plugin Word64
offs
  Word64
len <- CurrentPlugin -> Word64 -> IO Word64
memoryLength CurrentPlugin
plugin Word64
offs
  [Word8]
arr <- Int -> Ptr Word8 -> IO [Word8]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
len) Ptr Word8
ptr
  ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack [Word8]
arr

-- | Allocate memory and copy an existing 'ByteString' into it
allocBytes :: CurrentPlugin -> B.ByteString -> IO Word64
allocBytes :: CurrentPlugin -> ByteString -> IO Word64
allocBytes CurrentPlugin
plugin ByteString
s = do
  let length :: Int
length = ByteString -> Int
B.length ByteString
s
  Word64
offs <- CurrentPlugin -> Word64 -> IO Word64
memoryAlloc CurrentPlugin
plugin (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
length)
  Ptr Word8
ptr <- CurrentPlugin -> Word64 -> IO (Ptr Word8)
memoryOffset CurrentPlugin
plugin Word64
offs
  Ptr Word8 -> [Word8] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Word8
ptr (ByteString -> [Word8]
B.unpack ByteString
s)
  Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
offs