{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module FFICXX.Runtime.Function.Template where

import FFICXX.Runtime.Cast
  ( Castable (..),
    FPtr (..),
    Raw (..),
  )
import Foreign.Ptr (FunPtr, Ptr, castPtr)

data RawFunction t

newtype Function t = Function (Ptr (RawFunction t))

class IFunction t where
  newFunction :: FunPtr t -> IO (Function t)
  call :: Function t -> t
  deleteFunction :: Function t -> IO ()

instance () => FPtr (Function t) where
  type Raw (Function t) = RawFunction t
  get_fptr :: Function t -> Ptr (Raw (Function t))
get_fptr (Function Ptr (RawFunction t)
ptr) = Ptr (Raw (Function t))
Ptr (RawFunction t)
ptr
  cast_fptr_to_obj :: Ptr (Raw (Function t)) -> Function t
cast_fptr_to_obj = Ptr (Raw (Function t)) -> Function t
Ptr (RawFunction t) -> Function t
forall t. Ptr (RawFunction t) -> Function t
Function

instance () => Castable (Function t) (Ptr (RawFunction t)) where
  cast :: forall r. Function t -> (Ptr (RawFunction t) -> IO r) -> IO r
cast Function t
x Ptr (RawFunction t) -> IO r
f = Ptr (RawFunction t) -> IO r
f (Ptr (RawFunction t) -> Ptr (RawFunction t)
forall a b. Ptr a -> Ptr b
castPtr (Function t -> Ptr (Raw (Function t))
forall a. FPtr a => a -> Ptr (Raw a)
get_fptr Function t
x))
  uncast :: forall r. Ptr (RawFunction t) -> (Function t -> IO r) -> IO r
uncast Ptr (RawFunction t)
x Function t -> IO r
f = Function t -> IO r
f (Ptr (Raw (Function t)) -> Function t
forall a. FPtr a => Ptr (Raw a) -> a
cast_fptr_to_obj (Ptr (RawFunction t) -> Ptr (RawFunction t)
forall a b. Ptr a -> Ptr b
castPtr Ptr (RawFunction t)
x))

instance () => Castable (FunPtr t) (FunPtr t) where
  cast :: forall r. FunPtr t -> (FunPtr t -> IO r) -> IO r
cast FunPtr t
x FunPtr t -> IO r
f = FunPtr t -> IO r
f FunPtr t
x
  uncast :: forall r. FunPtr t -> (FunPtr t -> IO r) -> IO r
uncast FunPtr t
x FunPtr t -> IO r
f = FunPtr t -> IO r
f FunPtr t
x

class FunPtrWrapper t where
  wrapFunPtr :: t -> IO (FunPtr t)