module Foreign.Marshal.Alloc
  ( malloc       -- :: Storable a =>        IO (Ptr a)
  , mallocBytes  -- ::               Int -> IO (Ptr a)
  , alloca       -- :: Storable a =>        (Ptr a -> IO b) -> IO b
  , allocaBytes  -- ::               Int -> (Ptr a -> IO b) -> IO b
  , realloc      -- :: Storable b => Ptr a        -> IO (Ptr b)
  , reallocBytes -- ::               Ptr a -> Int -> IO (Ptr a)
  , free         -- :: Ptr a -> IO ()
  ) where

import Data.Maybe
import Foreign.Ptr              ( Ptr, nullPtr, FunPtr )
import Foreign.C.Types          ( CSize, CInt(..) )
import Foreign.Storable         ( Storable(sizeOf) )
import System.IO                ( bracket )

malloc :: Storable a => IO (Ptr a)
malloc  = doMalloc undefined
  where
    doMalloc       :: Storable a => a -> IO (Ptr a)
    doMalloc dummy  = mallocBytes (sizeOf dummy)

mallocBytes      :: Int -> IO (Ptr a)
mallocBytes size  = failWhenNULL "malloc" (_malloc (fromIntegral size))

alloca :: Storable a => (Ptr a -> IO b) -> IO b
alloca  = doAlloca undefined
  where
    doAlloca       :: Storable a => a -> (Ptr a -> IO b) -> IO b
    doAlloca dummy  = allocaBytes (sizeOf dummy)

allocaBytes      :: Int -> (Ptr a -> IO b) -> IO b
allocaBytes size  = bracket (mallocBytes size) free

realloc :: Storable b => Ptr a -> IO (Ptr b)
realloc  = doRealloc undefined
  where
    doRealloc           :: Storable b => b -> Ptr a -> IO (Ptr b)
    doRealloc dummy ptr  = let
                             size = fromIntegral (sizeOf dummy)
                           in
                           failWhenNULL "realloc" (_realloc ptr size)

reallocBytes          :: Ptr a -> Int -> IO (Ptr a)
reallocBytes ptr size  = 
  failWhenNULL "realloc" (_realloc ptr (fromIntegral size))

free :: Ptr a -> IO ()
free  = _free

failWhenNULL :: String -> IO (Ptr a) -> IO (Ptr a)
failWhenNULL name f = do
   addr <- f
   if addr == nullPtr
      then ioError (userError (name++": out of memory"))
      else return addr

foreign import ccall unsafe "stdlib.h malloc"
  _malloc  ::          CSize -> IO (Ptr a)
foreign import ccall unsafe "stdlib.h realloc"
  _realloc :: Ptr a -> CSize -> IO (Ptr b)
foreign import ccall unsafe "stdlib.h free"
  _free    :: Ptr a -> IO ()