-- | Events.
--
-- See <https://github.com/WebAssembly/binaryen/blob/master/src/binaryen-c.h>
-- for API documentation.
--
-- This module is intended to be imported qualified.

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Binaryen.Event where

import Binaryen.Type
import Foreign (Ptr, Storable)
import Foreign.C (CChar(..), CInt(..), CUIntPtr(..))

newtype Event = Event (Ptr Event)
  deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq, Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show, Ptr b -> Int -> IO Event
Ptr b -> Int -> Event -> IO ()
Ptr Event -> IO Event
Ptr Event -> Int -> IO Event
Ptr Event -> Int -> Event -> IO ()
Ptr Event -> Event -> IO ()
Event -> Int
(Event -> Int)
-> (Event -> Int)
-> (Ptr Event -> Int -> IO Event)
-> (Ptr Event -> Int -> Event -> IO ())
-> (forall b. Ptr b -> Int -> IO Event)
-> (forall b. Ptr b -> Int -> Event -> IO ())
-> (Ptr Event -> IO Event)
-> (Ptr Event -> Event -> IO ())
-> Storable Event
forall b. Ptr b -> Int -> IO Event
forall b. Ptr b -> Int -> Event -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Event -> Event -> IO ()
$cpoke :: Ptr Event -> Event -> IO ()
peek :: Ptr Event -> IO Event
$cpeek :: Ptr Event -> IO Event
pokeByteOff :: Ptr b -> Int -> Event -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Event -> IO ()
peekByteOff :: Ptr b -> Int -> IO Event
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Event
pokeElemOff :: Ptr Event -> Int -> Event -> IO ()
$cpokeElemOff :: Ptr Event -> Int -> Event -> IO ()
peekElemOff :: Ptr Event -> Int -> IO Event
$cpeekElemOff :: Ptr Event -> Int -> IO Event
alignment :: Event -> Int
$calignment :: Event -> Int
sizeOf :: Event -> Int
$csizeOf :: Event -> Int
Storable)

foreign import ccall unsafe "BinaryenEventGetName"
  getName ::
    Event -> IO (Ptr CChar)

foreign import ccall unsafe "BinaryenEventGetAttribute"
  getAttribute ::
    Event -> IO CInt

foreign import ccall unsafe "BinaryenEventGetParams"
  getParams ::
    Event -> IO Type

foreign import ccall unsafe "BinaryenEventGetResults"
  getResults ::
    Event -> IO Type

foreign import ccall unsafe "BinaryenEventImportGetModule"
  importGetModule ::
    Event -> IO (Ptr CChar)

foreign import ccall unsafe "BinaryenEventImportGetBase"
  eventImportGetBase ::
    Event -> IO (Ptr CChar)