1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
module Graphics.Text.Font.Choose.Internal.FFI where
import Data.MessagePack (MessagePack, pack, unpack)
import Foreign.C.String (CString, withCString, peekCString)
import Foreign.Ptr (Ptr)
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
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)
withMessageIO :: MessagePack a => (CString -> Int -> IO b) -> a -> IO b
withMessageIO cb a = unsafeUseAsCStringLen (toStrict $ pack a) (uncurry cb)
withMessage :: MessagePack a => (CString -> Int -> b) -> a -> b
withMessage inner arg = unsafePerformIO $ withMessageIO (\x -> return . inner x) arg
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
fromMessageIO :: MessagePack a => (Ptr Int -> IO CString) -> IO (Maybe a)
fromMessageIO inner = do
(a, b) <- withPtr $ \ptr -> do
throwNull =<< inner ptr
bs <- unsafePackMallocCStringLen (b, a)
return $ unpack $ fromStrict bs
fromMessageIO0 :: MessagePack a => (Ptr Int -> IO CString) -> IO a
fromMessageIO0 inner = fromJust <$> fromMessageIO inner
withCString' :: (CString -> a) -> String -> a
withCString' inner = unsafePerformIO . flip withCString (return . inner)
peekCString' :: CString -> String
peekCString' = unsafePerformIO . peekCString
withForeignPtr' :: (Ptr a -> b) -> ForeignPtr a -> b
withForeignPtr' inner arg = unsafePerformIO $ withForeignPtr arg $ 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)