{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Extism.HostFunction
  ( CurrentPlugin (..),
    ValType (..),
    Val (..),
    MemoryHandle,
    Function,
    memoryAlloc,
    memoryLength,
    memoryFree,
    memory,
    memoryOffset,
    memoryBytes,
    memoryString,
    memoryGet,
    allocBytes,
    allocString,
    alloc,
    toI32,
    toI64,
    toF32,
    toF64,
    fromI32,
    fromI64,
    fromF32,
    fromF64,
    hostFunction,
    hostFunction',
    newFunction,
    newFunction',
    input,
    output,
    getParams,
    setResults,
    ptr,
  )
where

import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as BS (c2w, unsafePackLenAddress)
import Data.IORef
import Data.Word
import Extism
import Extism.Bindings
import Extism.Encoding
import Foreign.C.String
import Foreign.Concurrent
import Foreign.ForeignPtr
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.StablePtr
import Foreign.Storable
import GHC.Ptr

ptr :: ValType
ptr :: ValType
ptr = ValType
I64

-- | Access the plugin that is currently executing from inside a host function
data CurrentPlugin = CurrentPlugin (Ptr ExtismCurrentPlugin) [Val] (Ptr Val) Int

-- | A memory handle represents an allocated block of Extism memory
newtype MemoryHandle = MemoryHandle Word64 deriving (Integer -> MemoryHandle
MemoryHandle -> MemoryHandle
MemoryHandle -> MemoryHandle -> MemoryHandle
(MemoryHandle -> MemoryHandle -> MemoryHandle)
-> (MemoryHandle -> MemoryHandle -> MemoryHandle)
-> (MemoryHandle -> MemoryHandle -> MemoryHandle)
-> (MemoryHandle -> MemoryHandle)
-> (MemoryHandle -> MemoryHandle)
-> (MemoryHandle -> MemoryHandle)
-> (Integer -> MemoryHandle)
-> Num MemoryHandle
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: MemoryHandle -> MemoryHandle -> MemoryHandle
+ :: MemoryHandle -> MemoryHandle -> MemoryHandle
$c- :: MemoryHandle -> MemoryHandle -> MemoryHandle
- :: MemoryHandle -> MemoryHandle -> MemoryHandle
$c* :: MemoryHandle -> MemoryHandle -> MemoryHandle
* :: MemoryHandle -> MemoryHandle -> MemoryHandle
$cnegate :: MemoryHandle -> MemoryHandle
negate :: MemoryHandle -> MemoryHandle
$cabs :: MemoryHandle -> MemoryHandle
abs :: MemoryHandle -> MemoryHandle
$csignum :: MemoryHandle -> MemoryHandle
signum :: MemoryHandle -> MemoryHandle
$cfromInteger :: Integer -> MemoryHandle
fromInteger :: Integer -> MemoryHandle
Num, Int -> MemoryHandle
MemoryHandle -> Int
MemoryHandle -> [MemoryHandle]
MemoryHandle -> MemoryHandle
MemoryHandle -> MemoryHandle -> [MemoryHandle]
MemoryHandle -> MemoryHandle -> MemoryHandle -> [MemoryHandle]
(MemoryHandle -> MemoryHandle)
-> (MemoryHandle -> MemoryHandle)
-> (Int -> MemoryHandle)
-> (MemoryHandle -> Int)
-> (MemoryHandle -> [MemoryHandle])
-> (MemoryHandle -> MemoryHandle -> [MemoryHandle])
-> (MemoryHandle -> MemoryHandle -> [MemoryHandle])
-> (MemoryHandle -> MemoryHandle -> MemoryHandle -> [MemoryHandle])
-> Enum MemoryHandle
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MemoryHandle -> MemoryHandle
succ :: MemoryHandle -> MemoryHandle
$cpred :: MemoryHandle -> MemoryHandle
pred :: MemoryHandle -> MemoryHandle
$ctoEnum :: Int -> MemoryHandle
toEnum :: Int -> MemoryHandle
$cfromEnum :: MemoryHandle -> Int
fromEnum :: MemoryHandle -> Int
$cenumFrom :: MemoryHandle -> [MemoryHandle]
enumFrom :: MemoryHandle -> [MemoryHandle]
$cenumFromThen :: MemoryHandle -> MemoryHandle -> [MemoryHandle]
enumFromThen :: MemoryHandle -> MemoryHandle -> [MemoryHandle]
$cenumFromTo :: MemoryHandle -> MemoryHandle -> [MemoryHandle]
enumFromTo :: MemoryHandle -> MemoryHandle -> [MemoryHandle]
$cenumFromThenTo :: MemoryHandle -> MemoryHandle -> MemoryHandle -> [MemoryHandle]
enumFromThenTo :: MemoryHandle -> MemoryHandle -> MemoryHandle -> [MemoryHandle]
Enum, MemoryHandle -> MemoryHandle -> Bool
(MemoryHandle -> MemoryHandle -> Bool)
-> (MemoryHandle -> MemoryHandle -> Bool) -> Eq MemoryHandle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MemoryHandle -> MemoryHandle -> Bool
== :: MemoryHandle -> MemoryHandle -> Bool
$c/= :: MemoryHandle -> MemoryHandle -> Bool
/= :: MemoryHandle -> MemoryHandle -> Bool
Eq, Eq MemoryHandle
Eq MemoryHandle =>
(MemoryHandle -> MemoryHandle -> Ordering)
-> (MemoryHandle -> MemoryHandle -> Bool)
-> (MemoryHandle -> MemoryHandle -> Bool)
-> (MemoryHandle -> MemoryHandle -> Bool)
-> (MemoryHandle -> MemoryHandle -> Bool)
-> (MemoryHandle -> MemoryHandle -> MemoryHandle)
-> (MemoryHandle -> MemoryHandle -> MemoryHandle)
-> Ord MemoryHandle
MemoryHandle -> MemoryHandle -> Bool
MemoryHandle -> MemoryHandle -> Ordering
MemoryHandle -> MemoryHandle -> MemoryHandle
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MemoryHandle -> MemoryHandle -> Ordering
compare :: MemoryHandle -> MemoryHandle -> Ordering
$c< :: MemoryHandle -> MemoryHandle -> Bool
< :: MemoryHandle -> MemoryHandle -> Bool
$c<= :: MemoryHandle -> MemoryHandle -> Bool
<= :: MemoryHandle -> MemoryHandle -> Bool
$c> :: MemoryHandle -> MemoryHandle -> Bool
> :: MemoryHandle -> MemoryHandle -> Bool
$c>= :: MemoryHandle -> MemoryHandle -> Bool
>= :: MemoryHandle -> MemoryHandle -> Bool
$cmax :: MemoryHandle -> MemoryHandle -> MemoryHandle
max :: MemoryHandle -> MemoryHandle -> MemoryHandle
$cmin :: MemoryHandle -> MemoryHandle -> MemoryHandle
min :: MemoryHandle -> MemoryHandle -> MemoryHandle
Ord, Num MemoryHandle
Ord MemoryHandle
(Num MemoryHandle, Ord MemoryHandle) =>
(MemoryHandle -> Rational) -> Real MemoryHandle
MemoryHandle -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: MemoryHandle -> Rational
toRational :: MemoryHandle -> Rational
Real, Enum MemoryHandle
Real MemoryHandle
(Real MemoryHandle, Enum MemoryHandle) =>
(MemoryHandle -> MemoryHandle -> MemoryHandle)
-> (MemoryHandle -> MemoryHandle -> MemoryHandle)
-> (MemoryHandle -> MemoryHandle -> MemoryHandle)
-> (MemoryHandle -> MemoryHandle -> MemoryHandle)
-> (MemoryHandle -> MemoryHandle -> (MemoryHandle, MemoryHandle))
-> (MemoryHandle -> MemoryHandle -> (MemoryHandle, MemoryHandle))
-> (MemoryHandle -> Integer)
-> Integral MemoryHandle
MemoryHandle -> Integer
MemoryHandle -> MemoryHandle -> (MemoryHandle, MemoryHandle)
MemoryHandle -> MemoryHandle -> MemoryHandle
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: MemoryHandle -> MemoryHandle -> MemoryHandle
quot :: MemoryHandle -> MemoryHandle -> MemoryHandle
$crem :: MemoryHandle -> MemoryHandle -> MemoryHandle
rem :: MemoryHandle -> MemoryHandle -> MemoryHandle
$cdiv :: MemoryHandle -> MemoryHandle -> MemoryHandle
div :: MemoryHandle -> MemoryHandle -> MemoryHandle
$cmod :: MemoryHandle -> MemoryHandle -> MemoryHandle
mod :: MemoryHandle -> MemoryHandle -> MemoryHandle
$cquotRem :: MemoryHandle -> MemoryHandle -> (MemoryHandle, MemoryHandle)
quotRem :: MemoryHandle -> MemoryHandle -> (MemoryHandle, MemoryHandle)
$cdivMod :: MemoryHandle -> MemoryHandle -> (MemoryHandle, MemoryHandle)
divMod :: MemoryHandle -> MemoryHandle -> (MemoryHandle, MemoryHandle)
$ctoInteger :: MemoryHandle -> Integer
toInteger :: MemoryHandle -> Integer
Integral, Int -> MemoryHandle -> ShowS
[MemoryHandle] -> ShowS
MemoryHandle -> String
(Int -> MemoryHandle -> ShowS)
-> (MemoryHandle -> String)
-> ([MemoryHandle] -> ShowS)
-> Show MemoryHandle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MemoryHandle -> ShowS
showsPrec :: Int -> MemoryHandle -> ShowS
$cshow :: MemoryHandle -> String
show :: MemoryHandle -> String
$cshowList :: [MemoryHandle] -> ShowS
showList :: [MemoryHandle] -> ShowS
Show)

-- | Allocate a new handle of the given size
memoryAlloc :: CurrentPlugin -> Word64 -> IO MemoryHandle
memoryAlloc :: CurrentPlugin -> Word64 -> IO MemoryHandle
memoryAlloc (CurrentPlugin Ptr ExtismCurrentPlugin
p [Val]
_ Ptr Val
_ Int
_) Word64
n = Word64 -> MemoryHandle
MemoryHandle (Word64 -> MemoryHandle) -> IO Word64 -> IO MemoryHandle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr ExtismCurrentPlugin -> Word64 -> IO Word64
extism_current_plugin_memory_alloc Ptr ExtismCurrentPlugin
p Word64
n

-- | Get the length of a handle, returns 0 if the handle is invalid
memoryLength :: CurrentPlugin -> MemoryHandle -> IO Word64
memoryLength :: CurrentPlugin -> MemoryHandle -> IO Word64
memoryLength (CurrentPlugin Ptr ExtismCurrentPlugin
p [Val]
_ Ptr Val
_ Int
_) (MemoryHandle Word64
offs) = Ptr ExtismCurrentPlugin -> Word64 -> IO Word64
extism_current_plugin_memory_length Ptr ExtismCurrentPlugin
p Word64
offs

-- | Free allocated memory
memoryFree :: CurrentPlugin -> MemoryHandle -> IO ()
memoryFree :: CurrentPlugin -> MemoryHandle -> IO ()
memoryFree (CurrentPlugin Ptr ExtismCurrentPlugin
p [Val]
_ Ptr Val
_ Int
_) (MemoryHandle Word64
offs) = Ptr ExtismCurrentPlugin -> Word64 -> IO ()
extism_current_plugin_memory_free Ptr ExtismCurrentPlugin
p Word64
offs

-- | Access a pointer to the entire memory region
memory :: CurrentPlugin -> IO (Ptr Word8)
memory :: CurrentPlugin -> IO (Ptr Word8)
memory (CurrentPlugin Ptr ExtismCurrentPlugin
p [Val]
_ Ptr Val
_ Int
_) = Ptr ExtismCurrentPlugin -> IO (Ptr Word8)
extism_current_plugin_memory Ptr ExtismCurrentPlugin
p

-- | Access the pointer for the given 'MemoryHandle'
memoryOffset :: CurrentPlugin -> MemoryHandle -> IO (Ptr Word8)
memoryOffset :: CurrentPlugin -> MemoryHandle -> IO (Ptr Word8)
memoryOffset (CurrentPlugin Ptr ExtismCurrentPlugin
plugin [Val]
_ Ptr Val
_ Int
_) (MemoryHandle Word64
offs) = do
  Ptr Word8
x <- Ptr ExtismCurrentPlugin -> IO (Ptr Word8)
extism_current_plugin_memory Ptr ExtismCurrentPlugin
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 -> MemoryHandle -> IO B.ByteString
memoryBytes :: CurrentPlugin -> MemoryHandle -> IO ByteString
memoryBytes CurrentPlugin
plugin MemoryHandle
offs = do
  Ptr Addr#
ptr <- CurrentPlugin -> MemoryHandle -> IO (Ptr Word8)
memoryOffset CurrentPlugin
plugin MemoryHandle
offs
  Word64
len <- CurrentPlugin -> MemoryHandle -> IO Word64
memoryLength CurrentPlugin
plugin MemoryHandle
offs
  Int -> Addr# -> IO ByteString
BS.unsafePackLenAddress (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
len) Addr#
ptr

-- | Access the data associated with a handle as a 'String'
memoryString :: CurrentPlugin -> MemoryHandle -> IO String
memoryString :: CurrentPlugin -> MemoryHandle -> IO String
memoryString CurrentPlugin
plugin MemoryHandle
offs = do
  ByteString -> String
fromByteString (ByteString -> String) -> IO ByteString -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CurrentPlugin -> MemoryHandle -> IO ByteString
memoryBytes CurrentPlugin
plugin MemoryHandle
offs

-- | Access the data associated with a handle and convert it into a Haskell type
memoryGet :: (FromBytes a) => CurrentPlugin -> MemoryHandle -> IO (Result a)
memoryGet :: forall a.
FromBytes a =>
CurrentPlugin -> MemoryHandle -> IO (Result a)
memoryGet CurrentPlugin
plugin MemoryHandle
offs = do
  ByteString
x <- CurrentPlugin -> MemoryHandle -> IO ByteString
memoryBytes CurrentPlugin
plugin MemoryHandle
offs
  Result a -> IO (Result a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result a -> IO (Result a)) -> Result a -> IO (Result a)
forall a b. (a -> b) -> a -> b
$ ByteString -> Result a
forall a. FromBytes a => ByteString -> Result a
fromBytes ByteString
x

-- | Access the data associated with a handle and convert it into a Haskell type
memoryGet' :: (FromBytes a) => CurrentPlugin -> MemoryHandle -> IO a
memoryGet' :: forall a. FromBytes a => CurrentPlugin -> MemoryHandle -> IO a
memoryGet' CurrentPlugin
plugin MemoryHandle
offs = do
  ByteString
x <- CurrentPlugin -> MemoryHandle -> IO ByteString
memoryBytes CurrentPlugin
plugin MemoryHandle
offs
  a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ Either Error a -> a
forall {b}. Either Error b -> b
unwrap (Either Error a -> a) -> Either Error a -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> Either Error a
forall a. FromBytes a => ByteString -> Result a
fromBytes ByteString
x

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

-- | Allocate memory and copy an existing 'String' into it
allocString :: CurrentPlugin -> String -> IO MemoryHandle
allocString :: CurrentPlugin -> String -> IO MemoryHandle
allocString CurrentPlugin
plugin String
s = do
  let length :: Int
length = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length String
s
  MemoryHandle
offs <- CurrentPlugin -> Word64 -> IO MemoryHandle
memoryAlloc CurrentPlugin
plugin (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
length)
  Ptr Word8
ptr <- CurrentPlugin -> MemoryHandle -> IO (Ptr Word8)
memoryOffset CurrentPlugin
plugin MemoryHandle
offs
  Ptr Word8 -> [Word8] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Word8
ptr ((Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map Char -> Word8
BS.c2w String
s)
  MemoryHandle -> IO MemoryHandle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MemoryHandle
offs

alloc :: (ToBytes a) => CurrentPlugin -> a -> IO MemoryHandle
alloc :: forall a. ToBytes a => CurrentPlugin -> a -> IO MemoryHandle
alloc CurrentPlugin
plugin a
x =
  let a :: ByteString
a = a -> ByteString
forall a. ToBytes a => a -> ByteString
toBytes a
x
   in CurrentPlugin -> ByteString -> IO MemoryHandle
allocBytes CurrentPlugin
plugin ByteString
a

-- | Create a new I32 'Val'
toI32 :: (Integral a) => a -> Val
toI32 :: forall a. Integral a => a -> Val
toI32 a
x = Int32 -> Val
ValI32 (a -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x)

-- | Create a new I64 'Val'
toI64 :: (Integral a) => a -> Val
toI64 :: forall a. Integral a => a -> Val
toI64 a
x = Int64 -> Val
ValI64 (a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x)

-- | Create a new F32 'Val'
toF32 :: Float -> Val
toF32 :: Float -> Val
toF32 = Float -> Val
ValF32

-- | Create a new F64 'Val'
toF64 :: Double -> Val
toF64 :: Double -> Val
toF64 = Double -> Val
ValF64

-- | Get I32 'Val'
fromI32 :: (Integral a) => Val -> Maybe a
fromI32 :: forall a. Integral a => Val -> Maybe a
fromI32 (ValI32 Int32
x) = a -> Maybe a
forall a. a -> Maybe a
Just (Int32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x)
fromI32 Val
_ = Maybe a
forall a. Maybe a
Nothing

-- | Get I64 'Val'
fromI64 :: (Integral a) => Val -> Maybe a
fromI64 :: forall a. Integral a => Val -> Maybe a
fromI64 (ValI64 Int64
x) = a -> Maybe a
forall a. a -> Maybe a
Just (Int64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x)
fromI64 Val
_ = Maybe a
forall a. Maybe a
Nothing

-- | Get F32 'Val'
fromF32 :: Val -> Maybe Float
fromF32 :: Val -> Maybe Float
fromF32 (ValF32 Float
x) = Float -> Maybe Float
forall a. a -> Maybe a
Just Float
x
fromF32 Val
_ = Maybe Float
forall a. Maybe a
Nothing

-- | Get F64 'Val'
fromF64 :: Val -> Maybe Double
fromF64 :: Val -> Maybe Double
fromF64 (ValF64 Double
x) = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
x
fromF64 Val
_ = Maybe Double
forall a. Maybe a
Nothing

setResults :: CurrentPlugin -> [Val] -> IO ()
setResults :: CurrentPlugin -> [Val] -> IO ()
setResults (CurrentPlugin Ptr ExtismCurrentPlugin
_ [Val]
_ Ptr Val
res Int
_) = Ptr Val -> [Val] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Val
res

getParams :: CurrentPlugin -> [Val]
getParams :: CurrentPlugin -> [Val]
getParams (CurrentPlugin Ptr ExtismCurrentPlugin
_ [Val]
params Ptr Val
_ Int
_) = [Val]
params

output :: (ToBytes a) => CurrentPlugin -> Int -> a -> IO ()
output :: forall a. ToBytes a => CurrentPlugin -> Int -> a -> IO ()
output !CurrentPlugin
p !Int
index !a
x =
  do
    MemoryHandle
mem <- CurrentPlugin -> a -> IO MemoryHandle
forall a. ToBytes a => CurrentPlugin -> a -> IO MemoryHandle
alloc CurrentPlugin
p a
x
    if Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len
      then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      else Ptr Val -> Int -> Val -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Val
res Int
index (MemoryHandle -> Val
forall a. Integral a => a -> Val
toI64 MemoryHandle
mem)
  where
    CurrentPlugin Ptr ExtismCurrentPlugin
_ [Val]
_ !Ptr Val
res !Int
len = CurrentPlugin
p

input :: (FromBytes a) => CurrentPlugin -> Int -> IO (Result a)
input :: forall a. FromBytes a => CurrentPlugin -> Int -> IO (Result a)
input CurrentPlugin
plugin Int
index =
  case Maybe Word64
x of
    Maybe Word64
Nothing -> Result a -> IO (Result a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result a -> IO (Result a)) -> Result a -> IO (Result a)
forall a b. (a -> b) -> a -> b
$ Error -> Result a
forall a b. a -> Either a b
Left (String -> Error
ExtismError String
"invalid parameter")
    Just Word64
offs -> do
      CurrentPlugin -> MemoryHandle -> IO (Result a)
forall a.
FromBytes a =>
CurrentPlugin -> MemoryHandle -> IO (Result a)
memoryGet CurrentPlugin
plugin (Word64 -> MemoryHandle
MemoryHandle Word64
offs)
  where
    (CurrentPlugin Ptr ExtismCurrentPlugin
_ [Val]
params Ptr Val
_ Int
_) = CurrentPlugin
plugin
    x :: Maybe Word64
x = Val -> Maybe Word64
forall a. Integral a => Val -> Maybe a
fromI64 ([Val]
params [Val] -> Int -> Val
forall a. HasCallStack => [a] -> Int -> a
!! Int
index) :: Maybe Word64

input' :: (FromBytes a) => CurrentPlugin -> Int -> IO a
input' :: forall a. FromBytes a => CurrentPlugin -> Int -> IO a
input' CurrentPlugin
plugin Int
index =
  Either Error a -> a
forall {b}. Either Error b -> b
unwrap (Either Error a -> a) -> IO (Either Error a) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CurrentPlugin -> Int -> IO (Either Error a)
forall a. FromBytes a => CurrentPlugin -> Int -> IO (Result a)
input CurrentPlugin
plugin Int
index

callback :: (CurrentPlugin -> a -> IO ()) -> (Ptr ExtismCurrentPlugin -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ())
callback :: forall a.
(CurrentPlugin -> a -> IO ())
-> Ptr ExtismCurrentPlugin
-> Ptr Val
-> Word64
-> Ptr Val
-> Word64
-> Ptr ()
-> IO ()
callback CurrentPlugin -> a -> IO ()
f Ptr ExtismCurrentPlugin
plugin Ptr Val
params Word64
nparams Ptr Val
results Word64
nresults Ptr ()
ptr = do
  [Val]
p <- Int -> Ptr Val -> IO [Val]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
nparams) Ptr Val
params
  (a
userData, Any
_, Any
_, Any
_) <- StablePtr (a, Any, Any, Any) -> IO (a, Any, Any, Any)
forall a. StablePtr a -> IO a
deRefStablePtr (Ptr () -> StablePtr (a, Any, Any, Any)
forall a. Ptr () -> StablePtr a
castPtrToStablePtr Ptr ()
ptr)
  CurrentPlugin -> a -> IO ()
f (Ptr ExtismCurrentPlugin -> [Val] -> Ptr Val -> Int -> CurrentPlugin
CurrentPlugin Ptr ExtismCurrentPlugin
plugin [Val]
p Ptr Val
results (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
nresults)) a
userData

hostFunctionWithNamespace' :: Maybe String
-> String
-> [ValType]
-> [ValType]
-> (CurrentPlugin -> a -> IO ())
-> a
-> IO Function
hostFunctionWithNamespace' Maybe String
ns String
name [ValType]
params [ValType]
results CurrentPlugin -> a -> IO ()
f a
v =
  do
    let g :: Ptr ExtismCurrentPlugin
-> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ()
g = (CurrentPlugin -> a -> IO ())
-> Ptr ExtismCurrentPlugin
-> Ptr Val
-> Word64
-> Ptr Val
-> Word64
-> Ptr ()
-> IO ()
forall a.
(CurrentPlugin -> a -> IO ())
-> Ptr ExtismCurrentPlugin
-> Ptr Val
-> Word64
-> Ptr Val
-> Word64
-> Ptr ()
-> IO ()
callback CurrentPlugin -> a -> IO ()
f
    FunPtr
  (Ptr ExtismCurrentPlugin
   -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ())
cb <- (Ptr ExtismCurrentPlugin
 -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ())
-> IO
     (FunPtr
        (Ptr ExtismCurrentPlugin
         -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ()))
callbackWrap Ptr ExtismCurrentPlugin
-> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ()
g
    FunPtr (Ptr () -> IO ())
free <- (Ptr () -> IO ()) -> IO (FunPtr (Ptr () -> IO ()))
freePtrWrap Ptr () -> IO ()
freePtr
    StablePtr
  (a, FunPtr (Ptr () -> IO ()),
   FunPtr
     (Ptr ExtismCurrentPlugin
      -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ()),
   Ptr ExtismCurrentPlugin
   -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ())
userData <- (a, FunPtr (Ptr () -> IO ()),
 FunPtr
   (Ptr ExtismCurrentPlugin
    -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ()),
 Ptr ExtismCurrentPlugin
 -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ())
-> IO
     (StablePtr
        (a, FunPtr (Ptr () -> IO ()),
         FunPtr
           (Ptr ExtismCurrentPlugin
            -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ()),
         Ptr ExtismCurrentPlugin
         -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ()))
forall a. a -> IO (StablePtr a)
newStablePtr (a
v, FunPtr (Ptr () -> IO ())
free, FunPtr
  (Ptr ExtismCurrentPlugin
   -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ())
cb, Ptr ExtismCurrentPlugin
-> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ()
g)
    let userDataPtr :: Ptr ()
userDataPtr = StablePtr
  (a, FunPtr (Ptr () -> IO ()),
   FunPtr
     (Ptr ExtismCurrentPlugin
      -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ()),
   Ptr ExtismCurrentPlugin
   -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ())
-> Ptr ()
forall a. StablePtr a -> Ptr ()
castStablePtrToPtr StablePtr
  (a, FunPtr (Ptr () -> IO ()),
   FunPtr
     (Ptr ExtismCurrentPlugin
      -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ()),
   Ptr ExtismCurrentPlugin
   -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ())
userData
    Ptr ExtismFunction
x <- String
-> (CString -> IO (Ptr ExtismFunction)) -> IO (Ptr ExtismFunction)
forall a. String -> (CString -> IO a) -> IO a
withCString String
name ((CString -> IO (Ptr ExtismFunction)) -> IO (Ptr ExtismFunction))
-> (CString -> IO (Ptr ExtismFunction)) -> IO (Ptr ExtismFunction)
forall a b. (a -> b) -> a -> b
$ \CString
name' ->
      [ValType]
-> (Ptr ValType -> IO (Ptr ExtismFunction))
-> IO (Ptr ExtismFunction)
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [ValType]
params ((Ptr ValType -> IO (Ptr ExtismFunction))
 -> IO (Ptr ExtismFunction))
-> (Ptr ValType -> IO (Ptr ExtismFunction))
-> IO (Ptr ExtismFunction)
forall a b. (a -> b) -> a -> b
$ \Ptr ValType
params' ->
        [ValType]
-> (Ptr ValType -> IO (Ptr ExtismFunction))
-> IO (Ptr ExtismFunction)
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [ValType]
results ((Ptr ValType -> IO (Ptr ExtismFunction))
 -> IO (Ptr ExtismFunction))
-> (Ptr ValType -> IO (Ptr ExtismFunction))
-> IO (Ptr ExtismFunction)
forall a b. (a -> b) -> a -> b
$ \Ptr ValType
results' ->
          CString
-> Ptr ValType
-> Word64
-> Ptr ValType
-> Word64
-> FunPtr
     (Ptr ExtismCurrentPlugin
      -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ())
-> Ptr ()
-> FunPtr (Ptr () -> IO ())
-> IO (Ptr ExtismFunction)
extism_function_new CString
name' Ptr ValType
params' Word64
nparams Ptr ValType
results' Word64
nresults FunPtr
  (Ptr ExtismCurrentPlugin
   -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ())
cb Ptr ()
userDataPtr FunPtr (Ptr () -> IO ())
free
    let freeFn :: IO ()
freeFn = Ptr ExtismFunction -> IO ()
extism_function_free Ptr ExtismFunction
x
    case Maybe String
ns of
      Maybe String
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just String
ns -> String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
ns (Ptr ExtismFunction -> CString -> IO ()
extism_function_set_namespace Ptr ExtismFunction
x)
    ForeignPtr ExtismFunction
fptr <- Ptr ExtismFunction -> IO () -> IO (ForeignPtr ExtismFunction)
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
Foreign.Concurrent.newForeignPtr Ptr ExtismFunction
x IO ()
freeFn
    Function -> IO Function
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Function -> IO Function) -> Function -> IO Function
forall a b. (a -> b) -> a -> b
$ ForeignPtr ExtismFunction -> StablePtr () -> Function
Function ForeignPtr ExtismFunction
fptr (Ptr () -> StablePtr ()
forall a. Ptr () -> StablePtr a
castPtrToStablePtr Ptr ()
userDataPtr)
  where
    nparams :: Word64
nparams = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [ValType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ValType]
params
    nresults :: Word64
nresults = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [ValType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ValType]
results

-- | @hostFunction "function_name" inputTypes outputTypes callback userData@ creates a new
-- | 'Extism.Function' in the default namespace that can be called from a 'Extism.Plugin'
hostFunction :: String -> [ValType] -> [ValType] -> (CurrentPlugin -> a -> IO ()) -> a -> IO Function
hostFunction :: forall a.
String
-> [ValType]
-> [ValType]
-> (CurrentPlugin -> a -> IO ())
-> a
-> IO Function
hostFunction = Maybe String
-> String
-> [ValType]
-> [ValType]
-> (CurrentPlugin -> a -> IO ())
-> a
-> IO Function
forall {a} {a}.
Maybe String
-> String
-> [ValType]
-> [ValType]
-> (CurrentPlugin -> a -> IO ())
-> a
-> IO Function
hostFunctionWithNamespace' Maybe String
forall a. Maybe a
Nothing

-- | @hostFunction' "namespace" "function_name" inputTypes outputTypes callback userData@ creates a new
-- | 'Extism.Function' in the provided namespace that can be called from a 'Extism.Plugin'
hostFunction' :: String -> String -> [ValType] -> [ValType] -> (CurrentPlugin -> a -> IO ()) -> a -> IO Function
hostFunction' :: forall a.
String
-> String
-> [ValType]
-> [ValType]
-> (CurrentPlugin -> a -> IO ())
-> a
-> IO Function
hostFunction' String
ns = Maybe String
-> String
-> [ValType]
-> [ValType]
-> (CurrentPlugin -> a -> IO ())
-> a
-> IO Function
forall {a} {a}.
Maybe String
-> String
-> [ValType]
-> [ValType]
-> (CurrentPlugin -> a -> IO ())
-> a
-> IO Function
hostFunctionWithNamespace' (String -> Maybe String
forall a. a -> Maybe a
Just String
ns)

-- | @newFunction' "function_name" inputTypes outputTypes userData callback@ creates a new
-- | 'Extism.Function' in the default namespace that can be called from a 'Extism.Plugin'
newFunction :: String -> [ValType] -> [ValType] -> a -> (CurrentPlugin -> a -> IO ()) -> IO Function
newFunction :: forall a.
String
-> [ValType]
-> [ValType]
-> a
-> (CurrentPlugin -> a -> IO ())
-> IO Function
newFunction String
name [ValType]
params [ValType]
results a
x CurrentPlugin -> a -> IO ()
f = Maybe String
-> String
-> [ValType]
-> [ValType]
-> (CurrentPlugin -> a -> IO ())
-> a
-> IO Function
forall {a} {a}.
Maybe String
-> String
-> [ValType]
-> [ValType]
-> (CurrentPlugin -> a -> IO ())
-> a
-> IO Function
hostFunctionWithNamespace' Maybe String
forall a. Maybe a
Nothing String
name [ValType]
params [ValType]
results CurrentPlugin -> a -> IO ()
f a
x

-- | @newFunction' "namespace" "function_name" inputTypes outputTypes  userData callback@ creates a new
-- | 'Extism.Function' in the provided namespace that can be called from a 'Extism.Plugin'
newFunction' :: String -> String -> [ValType] -> [ValType] -> a -> (CurrentPlugin -> a -> IO ()) -> IO Function
newFunction' :: forall a.
String
-> String
-> [ValType]
-> [ValType]
-> a
-> (CurrentPlugin -> a -> IO ())
-> IO Function
newFunction' String
ns String
name [ValType]
params [ValType]
results a
x CurrentPlugin -> a -> IO ()
f = Maybe String
-> String
-> [ValType]
-> [ValType]
-> (CurrentPlugin -> a -> IO ())
-> a
-> IO Function
forall {a} {a}.
Maybe String
-> String
-> [ValType]
-> [ValType]
-> (CurrentPlugin -> a -> IO ())
-> a
-> IO Function
hostFunctionWithNamespace' (String -> Maybe String
forall a. a -> Maybe a
Just String
ns) String
name [ValType]
params [ValType]
results CurrentPlugin -> a -> IO ()
f a
x