{-# LANGUAGE EmptyDataDecls, FlexibleInstances,
  MultiParamTypeClasses, TypeFamilies #-}
module STD.UniquePtr.Template where
import Foreign.C.Types
import Foreign.Ptr
import FFICXX.Runtime.Cast

data RawUniquePtr tp1

newtype UniquePtr tp1 = UniquePtr (Ptr (RawUniquePtr tp1))

class () => IUniquePtr tp1 where
        newUniquePtr0 :: IO (UniquePtr tp1)
        
        newUniquePtr :: tp1 -> IO (UniquePtr tp1)
        
        get :: UniquePtr tp1 -> IO tp1
        
        release :: UniquePtr tp1 -> IO tp1
        
        reset :: UniquePtr tp1 -> IO ()
        
        deleteUniquePtr :: UniquePtr tp1 -> IO ()

instance () => FPtr (UniquePtr tp1) where
        type Raw (UniquePtr tp1) = RawUniquePtr tp1
        get_fptr :: UniquePtr tp1 -> Ptr (Raw (UniquePtr tp1))
get_fptr (UniquePtr Ptr (RawUniquePtr tp1)
ptr) = Ptr (RawUniquePtr tp1)
ptr
        cast_fptr_to_obj :: Ptr (Raw (UniquePtr tp1)) -> UniquePtr tp1
cast_fptr_to_obj = forall tp1. Ptr (RawUniquePtr tp1) -> UniquePtr tp1
UniquePtr

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