{-# LANGUAGE ForeignFunctionInterface #-} module Extism.Bindings where import Foreign.C.Types import Foreign.Ptr import Foreign.C.String import Data.Int import Data.Word import Foreign.Storable import Foreign.Marshal.Array import Foreign.StablePtr type FreeCallback = Ptr () -> IO () newtype ExtismContext = ExtismContext () deriving Int -> ExtismContext -> ShowS [ExtismContext] -> ShowS ExtismContext -> String (Int -> ExtismContext -> ShowS) -> (ExtismContext -> String) -> ([ExtismContext] -> ShowS) -> Show ExtismContext forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> ExtismContext -> ShowS showsPrec :: Int -> ExtismContext -> ShowS $cshow :: ExtismContext -> String show :: ExtismContext -> String $cshowList :: [ExtismContext] -> ShowS showList :: [ExtismContext] -> 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 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) 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 (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 poke :: Ptr Val -> Val -> IO () poke Ptr Val ptr Val x = 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 x) case Val x 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 = do 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_context_new" extism_context_new :: IO (Ptr ExtismContext) foreign import ccall safe "extism.h &extism_context_free" extism_context_free :: FunPtr (Ptr ExtismContext -> IO ()) foreign import ccall safe "extism.h extism_plugin_new" extism_plugin_new :: Ptr ExtismContext -> Ptr Word8 -> Word64 -> Ptr (Ptr ExtismFunction) -> Word64 -> CBool -> IO Int32 foreign import ccall safe "extism.h extism_plugin_update" extism_plugin_update :: Ptr ExtismContext -> Int32 -> Ptr Word8 -> Word64 -> Ptr (Ptr ExtismFunction) -> Word64 -> CBool -> IO CBool foreign import ccall safe "extism.h extism_plugin_call" extism_plugin_call :: Ptr ExtismContext -> Int32 -> CString -> Ptr Word8 -> Word64 -> IO Int32 foreign import ccall safe "extism.h extism_plugin_function_exists" extism_plugin_function_exists :: Ptr ExtismContext -> Int32 -> CString -> IO CBool foreign import ccall safe "extism.h extism_error" extism_error :: Ptr ExtismContext -> Int32 -> IO CString foreign import ccall safe "extism.h extism_plugin_output_length" extism_plugin_output_length :: Ptr ExtismContext -> Int32 -> IO Word64 foreign import ccall safe "extism.h extism_plugin_output_data" extism_plugin_output_data :: Ptr ExtismContext -> Int32 -> 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 ExtismContext -> Int32 -> Ptr Word8 -> Int64 -> IO CBool foreign import ccall safe "extism.h extism_plugin_free" extism_plugin_free :: Ptr ExtismContext -> Int32 -> IO () foreign import ccall safe "extism.h extism_context_reset" extism_context_reset :: Ptr ExtismContext -> IO () foreign import ccall safe "extism.h extism_version" extism_version :: IO CString foreign import ccall safe "extism.h extism_plugin_cancel_handle" extism_plugin_cancel_handle :: Ptr ExtismContext -> Int32 -> 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_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 a, FunPtr Any b, FunPtr Any c) <- StablePtr (Any, FunPtr Any, FunPtr Any) -> IO (Any, FunPtr Any, FunPtr Any) forall a. StablePtr a -> IO a deRefStablePtr StablePtr (Any, FunPtr Any, FunPtr 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) callback :: (Ptr ExtismCurrentPlugin -> [Val] -> a -> IO [Val]) -> (Ptr ExtismCurrentPlugin -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ()) callback :: forall a. (Ptr ExtismCurrentPlugin -> [Val] -> a -> IO [Val]) -> Ptr ExtismCurrentPlugin -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO () callback Ptr ExtismCurrentPlugin -> [Val] -> a -> IO [Val] 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 _) <- StablePtr (a, Any, Any) -> IO (a, Any, Any) forall a. StablePtr a -> IO a deRefStablePtr (Ptr () -> StablePtr (a, Any, Any) forall a. Ptr () -> StablePtr a castPtrToStablePtr Ptr () ptr) [Val] res <- Ptr ExtismCurrentPlugin -> [Val] -> a -> IO [Val] f Ptr ExtismCurrentPlugin plugin [Val] p a userData Ptr Val -> [Val] -> IO () forall a. Storable a => Ptr a -> [a] -> IO () pokeArray Ptr Val results [Val] res