{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ForeignFunctionInterface #-}

-- |
--   Contains low-level bindings to the Extism SDK
module Extism.Bindings where

import Data.Int
import Data.Word
import Foreign.C.String
import Foreign.C.Types
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.StablePtr
import Foreign.Storable

type FreeCallback = Ptr () -> IO ()

newtype ExtismPlugin = ExtismPlugin () deriving (Int -> ExtismPlugin -> ShowS
[ExtismPlugin] -> ShowS
ExtismPlugin -> String
(Int -> ExtismPlugin -> ShowS)
-> (ExtismPlugin -> String)
-> ([ExtismPlugin] -> ShowS)
-> Show ExtismPlugin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtismPlugin -> ShowS
showsPrec :: Int -> ExtismPlugin -> ShowS
$cshow :: ExtismPlugin -> String
show :: ExtismPlugin -> String
$cshowList :: [ExtismPlugin] -> ShowS
showList :: [ExtismPlugin] -> ShowS
Show)

newtype ExtismFunction = ExtismFunction () deriving (Int -> ExtismFunction -> ShowS
[ExtismFunction] -> ShowS
ExtismFunction -> String
(Int -> ExtismFunction -> ShowS)
-> (ExtismFunction -> String)
-> ([ExtismFunction] -> ShowS)
-> Show ExtismFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtismFunction -> ShowS
showsPrec :: Int -> ExtismFunction -> ShowS
$cshow :: ExtismFunction -> String
show :: ExtismFunction -> String
$cshowList :: [ExtismFunction] -> ShowS
showList :: [ExtismFunction] -> ShowS
Show)

newtype ExtismCancelHandle = ExtismCancelHandle () deriving (Int -> ExtismCancelHandle -> ShowS
[ExtismCancelHandle] -> ShowS
ExtismCancelHandle -> String
(Int -> ExtismCancelHandle -> ShowS)
-> (ExtismCancelHandle -> String)
-> ([ExtismCancelHandle] -> ShowS)
-> Show ExtismCancelHandle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtismCancelHandle -> ShowS
showsPrec :: Int -> ExtismCancelHandle -> ShowS
$cshow :: ExtismCancelHandle -> String
show :: ExtismCancelHandle -> String
$cshowList :: [ExtismCancelHandle] -> ShowS
showList :: [ExtismCancelHandle] -> ShowS
Show)

newtype ExtismCurrentPlugin = ExtismCurrentPlugin () deriving (Int -> ExtismCurrentPlugin -> ShowS
[ExtismCurrentPlugin] -> ShowS
ExtismCurrentPlugin -> String
(Int -> ExtismCurrentPlugin -> ShowS)
-> (ExtismCurrentPlugin -> String)
-> ([ExtismCurrentPlugin] -> ShowS)
-> Show ExtismCurrentPlugin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtismCurrentPlugin -> ShowS
showsPrec :: Int -> ExtismCurrentPlugin -> ShowS
$cshow :: ExtismCurrentPlugin -> String
show :: ExtismCurrentPlugin -> String
$cshowList :: [ExtismCurrentPlugin] -> ShowS
showList :: [ExtismCurrentPlugin] -> ShowS
Show)

-- | Low-level Wasm types
data ValType = I32 | I64 | F32 | F64 | V128 | FuncRef | ExternRef deriving (Int -> ValType -> ShowS
[ValType] -> ShowS
ValType -> String
(Int -> ValType -> ShowS)
-> (ValType -> String) -> ([ValType] -> ShowS) -> Show ValType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValType -> ShowS
showsPrec :: Int -> ValType -> ShowS
$cshow :: ValType -> String
show :: ValType -> String
$cshowList :: [ValType] -> ShowS
showList :: [ValType] -> ShowS
Show, ValType -> ValType -> Bool
(ValType -> ValType -> Bool)
-> (ValType -> ValType -> Bool) -> Eq ValType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValType -> ValType -> Bool
== :: ValType -> ValType -> Bool
$c/= :: ValType -> ValType -> Bool
/= :: ValType -> ValType -> Bool
Eq)

-- | Low-level Wasm values
data Val = ValI32 Int32 | ValI64 Int64 | ValF32 Float | ValF64 Double deriving (Int -> Val -> ShowS
[Val] -> ShowS
Val -> String
(Int -> Val -> ShowS)
-> (Val -> String) -> ([Val] -> ShowS) -> Show Val
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Val -> ShowS
showsPrec :: Int -> Val -> ShowS
$cshow :: Val -> String
show :: Val -> String
$cshowList :: [Val] -> ShowS
showList :: [Val] -> ShowS
Show, Val -> Val -> Bool
(Val -> Val -> Bool) -> (Val -> Val -> Bool) -> Eq Val
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Val -> Val -> Bool
== :: Val -> Val -> Bool
$c/= :: Val -> Val -> Bool
/= :: Val -> Val -> Bool
Eq)

typeOfVal :: Val -> ValType
typeOfVal :: Val -> ValType
typeOfVal (ValI32 Int32
_) = ValType
I32
typeOfVal (ValI64 Int64
_) = ValType
I64
typeOfVal (ValF32 Float
_) = ValType
F32
typeOfVal (ValF64 Double
_) = ValType
F64

type CCallback = Ptr ExtismCurrentPlugin -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ()

_32Bit :: Bool
_32Bit = Int -> Int
forall a. Storable a => a -> Int
sizeOf (Int
forall a. HasCallStack => a
undefined :: Int) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4

instance Storable Val where
  sizeOf :: Val -> Int
sizeOf Val
_ =
    if Bool
_32Bit then Int
12 else Int
16
  alignment :: Val -> Int
alignment Val
_ = Int
1
  peek :: Ptr Val -> IO Val
peek Ptr Val
ptr = do
    let offs :: Int
offs = if Bool
_32Bit then Int
4 else Int
8
    ValType
t <- CInt -> ValType
valTypeOfInt (CInt -> ValType) -> IO CInt -> IO ValType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Val -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Val
ptr Int
0
    case ValType
t of
      ValType
I32 -> Int32 -> Val
ValI32 (Int32 -> Val) -> IO Int32 -> IO Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Val -> Int -> IO Int32
forall b. Ptr b -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Val
ptr Int
offs
      ValType
I64 -> Int64 -> Val
ValI64 (Int64 -> Val) -> IO Int64 -> IO Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Val -> Int -> IO Int64
forall b. Ptr b -> Int -> IO Int64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Val
ptr Int
offs
      ValType
F32 -> Float -> Val
ValF32 (Float -> Val) -> IO Float -> IO Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Val -> Int -> IO Float
forall b. Ptr b -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Val
ptr Int
offs
      ValType
F64 -> Double -> Val
ValF64 (Double -> Val) -> IO Double -> IO Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Val -> Int -> IO Double
forall b. Ptr b -> Int -> IO Double
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Val
ptr Int
offs
      ValType
_ -> String -> IO Val
forall a. HasCallStack => String -> a
error String
"Unsupported val type"
  poke :: Ptr Val -> Val -> IO ()
poke Ptr Val
ptr Val
a = do
    let offs :: Int
offs = if Bool
_32Bit then Int
4 else Int
8
    Ptr Val -> Int -> ValType -> IO ()
forall b. Ptr b -> Int -> ValType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Val
ptr Int
0 (Val -> ValType
typeOfVal Val
a)
    case Val
a of
      ValI32 Int32
x -> Ptr Val -> Int -> Int32 -> IO ()
forall b. Ptr b -> Int -> Int32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Val
ptr Int
offs Int32
x
      ValI64 Int64
x -> Ptr Val -> Int -> Int64 -> IO ()
forall b. Ptr b -> Int -> Int64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Val
ptr Int
offs Int64
x
      ValF32 Float
x -> Ptr Val -> Int -> Float -> IO ()
forall b. Ptr b -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Val
ptr Int
offs Float
x
      ValF64 Double
x -> Ptr Val -> Int -> Double -> IO ()
forall b. Ptr b -> Int -> Double -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Val
ptr Int
offs Double
x

intOfValType :: ValType -> CInt
intOfValType :: ValType -> CInt
intOfValType ValType
I32 = CInt
0
intOfValType ValType
I64 = CInt
1
intOfValType ValType
F32 = CInt
2
intOfValType ValType
F64 = CInt
3
intOfValType ValType
V128 = CInt
4
intOfValType ValType
FuncRef = CInt
5
intOfValType ValType
ExternRef = CInt
6

valTypeOfInt :: CInt -> ValType
valTypeOfInt :: CInt -> ValType
valTypeOfInt CInt
0 = ValType
I32
valTypeOfInt CInt
1 = ValType
I64
valTypeOfInt CInt
2 = ValType
F32
valTypeOfInt CInt
3 = ValType
F64
valTypeOfInt CInt
4 = ValType
V128
valTypeOfInt CInt
5 = ValType
FuncRef
valTypeOfInt CInt
6 = ValType
ExternRef
valTypeOfInt CInt
_ = String -> ValType
forall a. HasCallStack => String -> a
error String
"Invalid ValType"

instance Storable ValType where
  sizeOf :: ValType -> Int
sizeOf ValType
_ = Int
4
  alignment :: ValType -> Int
alignment ValType
_ = Int
1
  peek :: Ptr ValType -> IO ValType
peek Ptr ValType
ptr = do
    CInt
x <- Ptr ValType -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ValType
ptr Int
0
    ValType -> IO ValType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ValType -> IO ValType) -> ValType -> IO ValType
forall a b. (a -> b) -> a -> b
$ CInt -> ValType
valTypeOfInt (CInt
x :: CInt)
  poke :: Ptr ValType -> ValType -> IO ()
poke Ptr ValType
ptr ValType
x =
    Ptr ValType -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ValType
ptr Int
0 (ValType -> CInt
intOfValType ValType
x)

foreign import ccall safe "extism.h extism_plugin_new"
  extism_plugin_new ::
    Ptr Word8 -> Word64 -> Ptr (Ptr ExtismFunction) -> Word64 -> CBool -> Ptr CString -> IO (Ptr ExtismPlugin)

foreign import ccall safe "extism.h extism_plugin_call"
  extism_plugin_call ::
    Ptr ExtismPlugin -> CString -> Ptr Word8 -> Word64 -> IO Int32

foreign import ccall safe "extism.h extism_plugin_function_exists"
  extism_plugin_function_exists ::
    Ptr ExtismPlugin -> CString -> IO CBool

foreign import ccall safe "extism.h extism_plugin_error"
  extism_error ::
    Ptr ExtismPlugin -> IO CString

foreign import ccall safe "extism.h extism_plugin_output_length"
  extism_plugin_output_length ::
    Ptr ExtismPlugin -> IO Word64

foreign import ccall safe "extism.h extism_plugin_output_data"
  extism_plugin_output_data ::
    Ptr ExtismPlugin -> IO (Ptr Word8)

foreign import ccall safe "extism.h extism_log_file"
  extism_log_file ::
    CString -> CString -> IO CBool

foreign import ccall safe "extism.h extism_plugin_config"
  extism_plugin_config ::
    Ptr ExtismPlugin -> Ptr Word8 -> Int64 -> IO CBool

foreign import ccall safe "extism.h extism_plugin_free"
  extism_plugin_free ::
    Ptr ExtismPlugin -> IO ()

foreign import ccall safe "extism.h extism_plugin_reset"
  extism_plugin_reset ::
    Ptr ExtismPlugin -> IO ()

foreign import ccall safe "extism.h extism_plugin_new_error_free"
  extism_plugin_new_error_free ::
    CString -> IO ()

foreign import ccall safe "extism.h extism_version"
  extism_version ::
    IO CString

foreign import ccall safe "extism.h extism_plugin_id"
  extism_plugin_id ::
    Ptr ExtismPlugin -> IO (Ptr Word8)

foreign import ccall safe "extism.h extism_plugin_cancel_handle"
  extism_plugin_cancel_handle ::
    Ptr ExtismPlugin -> IO (Ptr ExtismCancelHandle)

foreign import ccall safe "extism.h extism_plugin_cancel"
  extism_plugin_cancel ::
    Ptr ExtismCancelHandle -> IO Bool

foreign import ccall safe "extism.h extism_function_new"
  extism_function_new ::
    CString -> Ptr ValType -> Word64 -> Ptr ValType -> Word64 -> FunPtr CCallback -> Ptr () -> FunPtr FreeCallback -> IO (Ptr ExtismFunction)

foreign import ccall safe "extism.h extism_function_free"
  extism_function_free ::
    Ptr ExtismFunction -> IO ()

foreign import ccall safe "extism.h extism_function_set_namespace"
  extism_function_set_namespace ::
    Ptr ExtismFunction -> CString -> IO ()

foreign import ccall safe "extism.h extism_current_plugin_memory"
  extism_current_plugin_memory ::
    Ptr ExtismCurrentPlugin -> IO (Ptr Word8)

foreign import ccall safe "extism.h extism_current_plugin_memory_alloc"
  extism_current_plugin_memory_alloc ::
    Ptr ExtismCurrentPlugin -> Word64 -> IO Word64

foreign import ccall safe "extism.h extism_current_plugin_memory_length"
  extism_current_plugin_memory_length ::
    Ptr ExtismCurrentPlugin -> Word64 -> IO Word64

foreign import ccall safe "extism.h extism_current_plugin_memory_free"
  extism_current_plugin_memory_free ::
    Ptr ExtismCurrentPlugin -> Word64 -> IO ()

freePtr :: Ptr () -> IO ()
freePtr Ptr ()
ptr = do
  let s :: StablePtr a
s = Ptr () -> StablePtr a
forall a. Ptr () -> StablePtr a
castPtrToStablePtr Ptr ()
ptr
  (Any
_, FunPtr Any
b, FunPtr Any
c, Any
_) <- StablePtr (Any, FunPtr Any, FunPtr Any, Any)
-> IO (Any, FunPtr Any, FunPtr Any, Any)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (Any, FunPtr Any, FunPtr Any, Any)
forall {a}. StablePtr a
s
  FunPtr Any -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr Any
b
  FunPtr Any -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr Any
c
  StablePtr Any -> IO ()
forall a. StablePtr a -> IO ()
freeStablePtr StablePtr Any
forall {a}. StablePtr a
s

foreign import ccall "wrapper" freePtrWrap :: FreeCallback -> IO (FunPtr FreeCallback)

foreign import ccall "wrapper" callbackWrap :: CCallback -> IO (FunPtr CCallback)