module Foreign.SharedPtr
  ( SharedPtr (), toSharedPtr, fromSharedPtr
  , Allocator
  , createAllocator, lookupAllocator, destroyAllocator
  , withNewAllocator, withAllocator, allocStoreName
  , malloc, mallocBytes, realloc, free
  ) where

import           Control.Exception                 (bracket)
import           Foreign.C.Error
import           Foreign.Marshal.Utils
import           Foreign.Ptr
import           Foreign.SharedObjectName.Internal
import           Foreign.SharedPtr.C
import           Foreign.Storable
import           System.IO.Unsafe                  (unsafePerformIO)


-- | Make a portable shared pointer out of a regular pointer.
--   The result can be transfered to another process and re-created using
--   the shared `Allocator`.
toSharedPtr :: Allocator -> Ptr a -> SharedPtr a
toSharedPtr :: Allocator -> Ptr a -> SharedPtr a
toSharedPtr = Allocator -> Ptr a -> SharedPtr a
forall a. Allocator -> Ptr a -> SharedPtr a
c'shared_ptrToShPtr

-- | Reconstruct a regular pointer from a portable shared pointer.
--   Returns @NULL@ if shared pointer or allocator are not valid.
fromSharedPtr :: Allocator -> SharedPtr a -> Ptr a
fromSharedPtr :: Allocator -> SharedPtr a -> Ptr a
fromSharedPtr = Allocator -> SharedPtr a -> Ptr a
forall a. Allocator -> SharedPtr a -> Ptr a
c'shared_shPtrToPtr

-- | Create a new `Allocator`.
createAllocator :: IO Allocator
createAllocator :: IO Allocator
createAllocator = String -> IO Allocator -> IO Allocator
forall a. String -> IO (Ptr a) -> IO (Ptr a)
checkNullPointer String
"SharedPtr.createAllocator"
                  IO Allocator
c'shared_createAllocator
{-# INLINE createAllocator #-}


-- | Lookup a `Allocator` by its name.
--   Use this to share one allocator between multiple processes.
lookupAllocator :: SOName Allocator -> IO Allocator
lookupAllocator :: SOName Allocator -> IO Allocator
lookupAllocator = String -> IO Allocator -> IO Allocator
forall a. String -> IO (Ptr a) -> IO (Ptr a)
checkNullPointer String
"SharedPtr.lookupAllocator"
                (IO Allocator -> IO Allocator)
-> (SOName Allocator -> IO Allocator)
-> SOName Allocator
-> IO Allocator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SOName Allocator -> (CString -> IO Allocator) -> IO Allocator)
-> (CString -> IO Allocator) -> SOName Allocator -> IO Allocator
forall a b c. (a -> b -> c) -> b -> a -> c
flip SOName Allocator -> (CString -> IO Allocator) -> IO Allocator
forall a b. SOName a -> (CString -> IO b) -> IO b
unsafeWithSOName CString -> IO Allocator
c'shared_lookupAllocator
{-# INLINE lookupAllocator #-}

-- | Destroy allocator instance.
--   Note: memory is fully unlinked and released only after
--         the last allocator sharing the memory is destroyed.
destroyAllocator :: Allocator -> IO ()
destroyAllocator :: Allocator -> IO ()
destroyAllocator = Allocator -> IO ()
c'shared_destroyAllocator
{-# INLINE destroyAllocator #-}

withNewAllocator :: (Allocator -> IO a) -> IO a
withNewAllocator :: (Allocator -> IO a) -> IO a
withNewAllocator = IO Allocator -> (Allocator -> IO ()) -> (Allocator -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Allocator
createAllocator Allocator -> IO ()
destroyAllocator
{-# INLINE withNewAllocator #-}

withAllocator :: SOName Allocator -> (Allocator -> IO a) -> IO a
withAllocator :: SOName Allocator -> (Allocator -> IO a) -> IO a
withAllocator SOName Allocator
s = IO Allocator -> (Allocator -> IO ()) -> (Allocator -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (SOName Allocator -> IO Allocator
lookupAllocator SOName Allocator
s) Allocator -> IO ()
destroyAllocator
{-# INLINE withAllocator #-}

allocStoreName :: Allocator -> SOName Allocator
allocStoreName :: Allocator -> SOName Allocator
allocStoreName Allocator
a = IO (SOName Allocator) -> SOName Allocator
forall a. IO a -> a
unsafePerformIO (IO (SOName Allocator) -> SOName Allocator)
-> IO (SOName Allocator) -> SOName Allocator
forall a b. (a -> b) -> a -> b
$ do
  SOName Allocator
n <- IO (SOName Allocator)
forall a. IO (SOName a)
newEmptySOName
  SOName Allocator -> (CString -> IO ()) -> IO ()
forall a b. SOName a -> (CString -> IO b) -> IO b
unsafeWithSOName SOName Allocator
n ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
    \CString
p -> CString -> CString -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes CString
p (Allocator -> CString
c'shared_getStoreName Allocator
a) (SOName Allocator -> Int
forall a. Storable a => a -> Int
sizeOf SOName Allocator
n)
  SOName Allocator -> IO (SOName Allocator)
forall (m :: * -> *) a. Monad m => a -> m a
return SOName Allocator
n
{-# NOINLINE allocStoreName #-}


malloc :: Storable a => Allocator -> IO (Ptr a)
malloc :: Allocator -> IO (Ptr a)
malloc Allocator
a = a -> IO (Ptr a)
forall b. Storable b => b -> IO (Ptr b)
go a
forall a. HasCallStack => a
undefined
  where
    go :: Storable b => b -> IO (Ptr b)
    go :: b -> IO (Ptr b)
go b
x = Allocator -> Int -> IO (Ptr b)
forall a. Allocator -> Int -> IO (Ptr a)
mallocBytes Allocator
a (b -> Int
forall a. Storable a => a -> Int
sizeOf b
x)

mallocBytes :: Allocator -> Int -> IO (Ptr a)
mallocBytes :: Allocator -> Int -> IO (Ptr a)
mallocBytes Allocator
a = String -> IO (Ptr a) -> IO (Ptr a)
forall a. String -> IO (Ptr a) -> IO (Ptr a)
checkNullPointer String
"SharedPtr.malloc"
              (IO (Ptr a) -> IO (Ptr a))
-> (Int -> IO (Ptr a)) -> Int -> IO (Ptr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Allocator -> CSize -> IO (Ptr a)
forall a. Allocator -> CSize -> IO (Ptr a)
c'shared_malloc Allocator
a (CSize -> IO (Ptr a)) -> (Int -> CSize) -> Int -> IO (Ptr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral

realloc :: Allocator -> Ptr a -> Int -> IO (Ptr a)
realloc :: Allocator -> Ptr a -> Int -> IO (Ptr a)
realloc Allocator
a Ptr a
p = String -> IO (Ptr a) -> IO (Ptr a)
forall a. String -> IO (Ptr a) -> IO (Ptr a)
checkNullPointer String
"SharedPtr.realloc"
            (IO (Ptr a) -> IO (Ptr a))
-> (Int -> IO (Ptr a)) -> Int -> IO (Ptr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Allocator -> Ptr a -> CSize -> IO (Ptr a)
forall a. Allocator -> Ptr a -> CSize -> IO (Ptr a)
c'shared_realloc Allocator
a Ptr a
p (CSize -> IO (Ptr a)) -> (Int -> CSize) -> Int -> IO (Ptr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral

free :: Allocator -> Ptr a -> IO ()
free :: Allocator -> Ptr a -> IO ()
free = Allocator -> Ptr a -> IO ()
forall a. Allocator -> Ptr a -> IO ()
c'shared_free


checkNullPointer :: String -> IO (Ptr a) -> IO (Ptr a)
checkNullPointer :: String -> IO (Ptr a) -> IO (Ptr a)
checkNullPointer String
s IO (Ptr a)
k = do
  Ptr a
p <- IO (Ptr a)
k
  if Ptr a
p Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr
  then String -> IO (Ptr a)
forall a. String -> IO a
throwErrno (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" returned NULL pointer.")
  else Ptr a -> IO (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
p