~alcinnz/fontconfig-pure

ref: 18b29da8fa2cc23650f2fd33c0917bcc2289a7b6 fontconfig-pure/lib/Graphics/Text/Font/Choose/Internal/FFI.hs -rw-r--r-- 2.1 KiB
18b29da8 — Adrian Cochrane Expose font weight adjustments & correct current-config refcount. 8 months ago
                                                                                
bea597e7 Adrian Cochrane
9aee49dd Adrian Cochrane
bea597e7 Adrian Cochrane
9aee49dd Adrian Cochrane
bea597e7 Adrian Cochrane
9aee49dd Adrian Cochrane
bea597e7 Adrian Cochrane
9aee49dd Adrian Cochrane
bea597e7 Adrian Cochrane
9aee49dd Adrian Cochrane
bea597e7 Adrian Cochrane
9aee49dd Adrian Cochrane
bea597e7 Adrian Cochrane
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)