{-# OPTIONS -Wall #-}
module Raylib.ForeignUtil (c'free, p'free, freeMaybePtr, Freeable (..), rlFreeArray, rlFreeMaybeArray, pop, popCArray, popCString, withFreeable, withFreeableArray, withFreeableArrayLen, withFreeableArray2D, configsToBitflag, withMaybe, withMaybeCString, peekMaybe, peekMaybeOff, pokeMaybe, pokeMaybeOff, peekMaybeArray, newMaybeArray, peekStaticArray, peekStaticArrayOff, pokeStaticArray, pokeStaticArrayOff, rightPad) where
import Control.Monad (forM_, unless)
import Data.Bits ((.|.))
import Foreign (FunPtr, Ptr, Storable (peek, peekByteOff, poke, sizeOf), castPtr, malloc, newArray, nullPtr, peekArray, plusPtr, with)
import Foreign.C (CFloat, CInt, CString, CUChar, CUInt, peekCString, withCString)
import Foreign.C.Types (CBool, CChar, CShort, CUShort)
foreign import ccall "stdlib.h free" c'free :: Ptr () -> IO ()
foreign import ccall "stdlib.h &free" p'free :: FunPtr (Ptr a -> IO ())
freeMaybePtr :: Ptr () -> IO ()
freeMaybePtr :: Ptr () -> IO ()
freeMaybePtr Ptr ()
ptr = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Ptr ()
ptr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
nullPtr) (Ptr () -> IO ()
c'free Ptr ()
ptr)
class Freeable a where
rlFreeDependents :: a -> Ptr a -> IO ()
rlFreeDependents a
_ Ptr a
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
rlFree :: a -> Ptr a -> IO ()
rlFree a
val Ptr a
ptr = a -> Ptr a -> IO ()
forall a. Freeable a => a -> Ptr a -> IO ()
rlFreeDependents a
val Ptr a
ptr IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr () -> IO ()
c'free (Ptr a -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr)
instance Freeable CBool
instance Freeable CChar
instance Freeable CFloat
instance Freeable CInt
instance Freeable CShort
instance Freeable CUChar
instance Freeable CUInt
instance Freeable CUShort
instance (Freeable a, Storable a) => Freeable [a] where
rlFreeDependents :: [a] -> Ptr [a] -> IO ()
rlFreeDependents [a]
arr Ptr [a]
ptr =
[Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
[Int
0 .. [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
( \Int
i -> do
let val :: a
val = [a]
arr [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
i in a -> Ptr a -> IO ()
forall a. Freeable a => a -> Ptr a -> IO ()
rlFreeDependents a
val (Ptr [a] -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr [a]
ptr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf a
val))
)
rlFreeArray :: (Freeable a, Storable a) => [a] -> Ptr a -> IO ()
rlFreeArray :: forall a. (Freeable a, Storable a) => [a] -> Ptr a -> IO ()
rlFreeArray [a]
arr Ptr a
ptr = [a] -> Ptr [a] -> IO ()
forall a. Freeable a => a -> Ptr a -> IO ()
rlFree [a]
arr (Ptr a -> Ptr [a]
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr)
rlFreeMaybeArray :: (Freeable a, Storable a) => Maybe [a] -> Ptr a -> IO ()
rlFreeMaybeArray :: forall a. (Freeable a, Storable a) => Maybe [a] -> Ptr a -> IO ()
rlFreeMaybeArray Maybe [a]
Nothing Ptr a
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
rlFreeMaybeArray (Just [a]
arr) Ptr a
ptr = [a] -> Ptr a -> IO ()
forall a. (Freeable a, Storable a) => [a] -> Ptr a -> IO ()
rlFreeArray [a]
arr Ptr a
ptr
pop :: (Freeable a, Storable a) => Ptr a -> IO a
pop :: forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop Ptr a
ptr = do
a
val <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
ptr
a -> Ptr a -> IO ()
forall a. Freeable a => a -> Ptr a -> IO ()
rlFree a
val Ptr a
ptr
a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val
popCArray :: (Freeable a, Storable a) => Int -> Ptr a -> IO [a]
popCArray :: forall a. (Freeable a, Storable a) => Int -> Ptr a -> IO [a]
popCArray Int
count Ptr a
ptr = do
[a]
str <- Int -> Ptr a -> IO [a]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
count Ptr a
ptr
Ptr () -> IO ()
c'free (Ptr () -> IO ()) -> Ptr () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr a -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr
[a] -> IO [a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
str
popCString :: CString -> IO String
popCString :: Ptr CChar -> IO String
popCString Ptr CChar
ptr = do
String
str <- Ptr CChar -> IO String
peekCString Ptr CChar
ptr
Ptr () -> IO ()
c'free (Ptr () -> IO ()) -> Ptr () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CChar -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ptr
String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
str
withFreeable :: (Freeable a, Storable a) => a -> (Ptr a -> IO b) -> IO b
withFreeable :: forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable a
val Ptr a -> IO b
f = do
Ptr a
ptr <- IO (Ptr a)
forall a. Storable a => IO (Ptr a)
malloc
Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
val
b
result <- Ptr a -> IO b
f Ptr a
ptr
a -> Ptr a -> IO ()
forall a. Freeable a => a -> Ptr a -> IO ()
rlFree a
val Ptr a
ptr
b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
result
withFreeableArray :: (Freeable a, Storable a) => [a] -> (Ptr a -> IO b) -> IO b
withFreeableArray :: forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray [a]
arr Ptr a -> IO b
f = do
Ptr a
ptr <- [a] -> IO (Ptr a)
forall a. Storable a => [a] -> IO (Ptr a)
newArray [a]
arr
b
result <- Ptr a -> IO b
f Ptr a
ptr
[a] -> Ptr a -> IO ()
forall a. (Freeable a, Storable a) => [a] -> Ptr a -> IO ()
rlFreeArray [a]
arr Ptr a
ptr
b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
result
withFreeableArrayLen :: (Freeable a, Storable a) => [a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen :: forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen [a]
arr Int -> Ptr a -> IO b
f = do
Ptr a
ptr <- [a] -> IO (Ptr a)
forall a. Storable a => [a] -> IO (Ptr a)
newArray [a]
arr
b
result <- Int -> Ptr a -> IO b
f ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
arr) Ptr a
ptr
[a] -> Ptr a -> IO ()
forall a. (Freeable a, Storable a) => [a] -> Ptr a -> IO ()
rlFreeArray [a]
arr Ptr a
ptr
b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
result
withFreeableArray2D :: (Freeable a, Storable a) => [[a]] -> (Ptr (Ptr a) -> IO b) -> IO b
withFreeableArray2D :: forall a b.
(Freeable a, Storable a) =>
[[a]] -> (Ptr (Ptr a) -> IO b) -> IO b
withFreeableArray2D [[a]]
arr Ptr (Ptr a) -> IO b
func = do
[Ptr a]
arrays <- ([a] -> IO (Ptr a)) -> [[a]] -> IO [Ptr a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [a] -> IO (Ptr a)
forall a. Storable a => [a] -> IO (Ptr a)
newArray [[a]]
arr
Ptr (Ptr a)
ptr <- [Ptr a] -> IO (Ptr (Ptr a))
forall a. Storable a => [a] -> IO (Ptr a)
newArray [Ptr a]
arrays
b
res <- Ptr (Ptr a) -> IO b
func Ptr (Ptr a)
ptr
[(Int, Ptr a)] -> ((Int, Ptr a) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [Ptr a] -> [(Int, Ptr a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Ptr a]
arrays) (\(Int
i, Ptr a
a) -> [a] -> Ptr a -> IO ()
forall a. (Freeable a, Storable a) => [a] -> Ptr a -> IO ()
rlFreeArray ([[a]]
arr [[a]] -> Int -> [a]
forall a. HasCallStack => [a] -> Int -> a
!! Int
i) Ptr a
a)
Ptr () -> IO ()
c'free (Ptr () -> IO ()) -> Ptr () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr a) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr a)
ptr
b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
res
configsToBitflag :: (Enum a) => [a] -> Integer
configsToBitflag :: forall a. Enum a => [a] -> Integer
configsToBitflag = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> ([a] -> Int) -> [a] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Int -> Int) -> Int -> [a] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Int -> Int
forall {a}. Enum a => a -> Int -> Int
folder (Int -> Int
forall a. Enum a => Int -> a
toEnum Int
0)
where
folder :: a -> Int -> Int
folder a
a Int
b = a -> Int
forall a. Enum a => a -> Int
fromEnum a
a Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
b
withMaybe :: (Storable a) => Maybe a -> (Ptr a -> IO b) -> IO b
withMaybe :: forall a b. Storable a => Maybe a -> (Ptr a -> IO b) -> IO b
withMaybe Maybe a
a Ptr a -> IO b
f = case Maybe a
a of
(Just a
val) -> a -> (Ptr a -> IO b) -> IO b
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
val Ptr a -> IO b
f
Maybe a
Nothing -> Ptr a -> IO b
f Ptr a
forall a. Ptr a
nullPtr
withMaybeCString :: Maybe String -> (CString -> IO b) -> IO b
withMaybeCString :: forall b. Maybe String -> (Ptr CChar -> IO b) -> IO b
withMaybeCString Maybe String
a Ptr CChar -> IO b
f = case Maybe String
a of
(Just String
val) -> String -> (Ptr CChar -> IO b) -> IO b
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
val Ptr CChar -> IO b
f
Maybe String
Nothing -> Ptr CChar -> IO b
f Ptr CChar
forall a. Ptr a
nullPtr
peekMaybe :: (Storable a) => Ptr (Ptr a) -> IO (Maybe a)
peekMaybe :: forall a. Storable a => Ptr (Ptr a) -> IO (Maybe a)
peekMaybe Ptr (Ptr a)
ptr = do
Ptr a
ref <- Ptr (Ptr a) -> IO (Ptr a)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr a)
ptr
if Ptr a
ref Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr then Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
ref
peekMaybeOff :: (Storable a) => Ptr (Ptr a) -> Int -> IO (Maybe a)
peekMaybeOff :: forall a. Storable a => Ptr (Ptr a) -> Int -> IO (Maybe a)
peekMaybeOff Ptr (Ptr a)
ptr Int
off = do
Ptr a
ref <- Ptr (Ptr a) -> Int -> IO (Ptr a)
forall b. Ptr b -> Int -> IO (Ptr a)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr (Ptr a)
ptr Int
off
if Ptr a
ref Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr then Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
ref
pokeMaybe :: (Storable a) => Ptr (Ptr a) -> Maybe a -> IO ()
pokeMaybe :: forall a. Storable a => Ptr (Ptr a) -> Maybe a -> IO ()
pokeMaybe Ptr (Ptr a)
ptr Maybe a
val = case Maybe a
val of
Maybe a
Nothing -> Ptr (Ptr a) -> Ptr a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr a)
ptr Ptr a
forall a. Ptr a
nullPtr
Just a
a -> a -> (Ptr a -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
a ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr a) -> Ptr a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr a)
ptr
pokeMaybeOff :: (Storable a) => Ptr (Ptr a) -> Int -> Maybe a -> IO ()
pokeMaybeOff :: forall a. Storable a => Ptr (Ptr a) -> Int -> Maybe a -> IO ()
pokeMaybeOff Ptr (Ptr a)
ptr Int
off = Ptr (Ptr a) -> Maybe a -> IO ()
forall a. Storable a => Ptr (Ptr a) -> Maybe a -> IO ()
pokeMaybe (Ptr (Ptr a) -> Int -> Ptr (Ptr a)
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr (Ptr a)
ptr Int
off)
peekMaybeArray :: (Storable a) => Int -> Ptr a -> IO (Maybe [a])
peekMaybeArray :: forall a. Storable a => Int -> Ptr a -> IO (Maybe [a])
peekMaybeArray Int
size Ptr a
ptr = if Ptr a
ptr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr then Maybe [a] -> IO (Maybe [a])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [a]
forall a. Maybe a
Nothing else [a] -> Maybe [a]
forall a. a -> Maybe a
Just ([a] -> Maybe [a]) -> IO [a] -> IO (Maybe [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Ptr a -> IO [a]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
size Ptr a
ptr
newMaybeArray :: (Storable a) => Maybe [a] -> IO (Ptr a)
newMaybeArray :: forall a. Storable a => Maybe [a] -> IO (Ptr a)
newMaybeArray Maybe [a]
a = case Maybe [a]
a of
(Just [a]
arr) -> [a] -> IO (Ptr a)
forall a. Storable a => [a] -> IO (Ptr a)
newArray [a]
arr
Maybe [a]
Nothing -> Ptr a -> IO (Ptr a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
forall a. Ptr a
nullPtr
peekStaticArray :: (Storable a) => Int -> Ptr a -> IO [a]
peekStaticArray :: forall a. Storable a => Int -> Ptr a -> IO [a]
peekStaticArray Int
size Ptr a
ptr = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> IO [a] -> IO [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Ptr a -> [a] -> IO [a]
forall {t} {b}.
(Eq t, Num t, Storable b) =>
t -> Ptr b -> [b] -> IO [b]
helper Int
size Ptr a
ptr []
where
helper :: t -> Ptr b -> [b] -> IO [b]
helper t
s Ptr b
p [b]
a =
if t
s t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0
then [b] -> IO [b]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [b]
a
else do
b
val <- Ptr b -> IO b
forall a. Storable a => Ptr a -> IO a
peek Ptr b
p
t -> Ptr b -> [b] -> IO [b]
helper (t
s t -> t -> t
forall a. Num a => a -> a -> a
- t
1) (Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr b
p (b -> Int
forall a. Storable a => a -> Int
sizeOf b
val)) (b
val b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
a)
peekStaticArrayOff :: (Storable a) => Int -> Ptr a -> Int -> IO [a]
peekStaticArrayOff :: forall a. Storable a => Int -> Ptr a -> Int -> IO [a]
peekStaticArrayOff Int
size Ptr a
ptr Int
off = Int -> Ptr a -> IO [a]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekStaticArray Int
size (Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr a
ptr Int
off)
pokeStaticArray :: (Storable a) => Ptr a -> [a] -> IO ()
pokeStaticArray :: forall a. Storable a => Ptr a -> [a] -> IO ()
pokeStaticArray Ptr a
_ [] = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
pokeStaticArray Ptr a
ptr (a
x : [a]
xs) = Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
x IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr a -> [a] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeStaticArray (Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr a
ptr (Int -> Ptr a) -> Int -> Ptr a
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Storable a => a -> Int
sizeOf a
x) [a]
xs
pokeStaticArrayOff :: (Storable a) => Ptr a -> Int -> [a] -> IO ()
pokeStaticArrayOff :: forall a. Storable a => Ptr a -> Int -> [a] -> IO ()
pokeStaticArrayOff Ptr a
ptr Int
off = Ptr a -> [a] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeStaticArray (Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr a
ptr Int
off)
rightPad :: Int -> a -> [a] -> [a]
rightPad :: forall a. Int -> a -> [a] -> [a]
rightPad Int
size a
val [a]
arr = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
size ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a]
arr [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a -> [a]
forall a. a -> [a]
repeat a
val