module Graphics.Text.Font.Choose.Internal.FFI where

import Data.MessagePack (MessagePack, pack, unpack)
import Foreign.C.String (CString, withCString)
import Foreign.Ptr (Ptr)
import Foreign.Storable (Storable(..))
import Foreign.Marshal.Alloc (alloca)
import Data.Tuple (swap)
import Graphics.Text.Font.Choose.Result (throwNull)
import Data.Maybe (fromJust)

import Data.ByteString.Unsafe (unsafeUseAsCStringLen, unsafePackMallocCStringLen)
import Data.ByteString.Lazy (toStrict, fromStrict)
import System.IO.Unsafe (unsafePerformIO)

withMessage :: MessagePack a => (CString -> Int -> b) -> a -> b
withMessage inner arg = unsafePerformIO $
    unsafeUseAsCStringLen (toStrict $ pack arg) (return . uncurry inner)

fromMessage :: MessagePack a => (Ptr Int -> CString) -> Maybe a
fromMessage inner = unpack $ fromStrict $ unsafePerformIO $ do
    unsafePackMallocCStringLen . swap =<< withPtr (throwNull . inner)

fromMessage0 :: MessagePack a => (Ptr Int -> CString) -> a
fromMessage0 = fromJust . fromMessage

withCString' :: (CString -> a) -> String -> a
withCString' inner = unsafePerformIO . flip withCString (return . inner)

-- I don't want to pull in all of inline-c for this util!
withPtr :: (Storable a) => (Ptr a -> IO b) -> IO (a, b)
withPtr f = do
  alloca $ \ptr -> do
    x <- f ptr
    y <- peek ptr
    return (y, x)