{-# 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 = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Ptr ()
ptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr) (Ptr () -> IO ()
c'free Ptr ()
ptr)
class Freeable a where
rlFreeDependents :: a -> Ptr a -> IO ()
rlFreeDependents a
_ Ptr a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
rlFree :: a -> Ptr a -> IO ()
rlFree a
val Ptr a
ptr = forall a. Freeable a => a -> Ptr a -> IO ()
rlFreeDependents a
val Ptr a
ptr forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr () -> IO ()
c'free (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 =
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
[Int
0 .. forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
arr forall a. Num a => a -> a -> a
- Int
1]
( \Int
i -> do
let val :: a
val = [a]
arr forall a. [a] -> Int -> a
!! Int
i in forall a. Freeable a => a -> Ptr a -> IO ()
rlFreeDependents a
val (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr [a]
ptr (Int
i forall a. Num a => a -> a -> a
* 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 = forall a. Freeable a => a -> Ptr a -> IO ()
rlFree [a]
arr (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
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
rlFreeMaybeArray (Just [a]
arr) Ptr a
ptr = 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 <- forall a. Storable a => Ptr a -> IO a
peek Ptr a
ptr
forall a. Freeable a => a -> Ptr a -> IO ()
rlFree a
val Ptr a
ptr
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 <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
count Ptr a
ptr
Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr
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 forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ptr
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 <- forall a. Storable a => IO (Ptr a)
malloc
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
val
b
result <- Ptr a -> IO b
f Ptr a
ptr
forall a. Freeable a => a -> Ptr a -> IO ()
rlFree a
val Ptr a
ptr
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 <- forall a. Storable a => [a] -> IO (Ptr a)
newArray [a]
arr
b
result <- Ptr a -> IO b
f Ptr a
ptr
forall a. (Freeable a, Storable a) => [a] -> Ptr a -> IO ()
rlFreeArray [a]
arr Ptr a
ptr
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 <- forall a. Storable a => [a] -> IO (Ptr a)
newArray [a]
arr
b
result <- Int -> Ptr a -> IO b
f (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
arr) Ptr a
ptr
forall a. (Freeable a, Storable a) => [a] -> Ptr a -> IO ()
rlFreeArray [a]
arr Ptr a
ptr
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 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Storable a => [a] -> IO (Ptr a)
newArray [[a]]
arr
Ptr (Ptr a)
ptr <- forall a. Storable a => [a] -> IO (Ptr a)
newArray [Ptr a]
arrays
b
res <- Ptr (Ptr a) -> IO b
func Ptr (Ptr a)
ptr
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Ptr a]
arrays) (\(Int
i, Ptr a
a) -> forall a. (Freeable a, Storable a) => [a] -> Ptr a -> IO ()
rlFreeArray ([[a]]
arr forall a. [a] -> Int -> a
!! Int
i) Ptr a
a)
Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr a)
ptr
forall (m :: * -> *) a. Monad m => a -> m a
return b
res
configsToBitflag :: (Enum a) => [a] -> Integer
configsToBitflag :: forall a. Enum a => [a] -> Integer
configsToBitflag = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}. Enum a => a -> Int -> Int
folder (forall a. Enum a => Int -> a
toEnum Int
0)
where
folder :: a -> Int -> Int
folder a
a Int
b = forall a. Enum a => a -> Int
fromEnum a
a 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) -> 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 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) -> 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 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 <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr a)
ptr
if Ptr a
ref forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr (Ptr a)
ptr Int
off
if Ptr a
ref forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr a)
ptr forall a. Ptr a
nullPtr
Just a
a -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
a forall a b. (a -> b) -> a -> b
$ 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 = forall a. Storable a => Ptr (Ptr a) -> Maybe a -> IO ()
pokeMaybe (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 forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) -> forall a. Storable a => [a] -> IO (Ptr a)
newArray [a]
arr
Maybe [a]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. Eq a => a -> a -> Bool
== t
0
then forall (m :: * -> *) a. Monad m => a -> m a
return [b]
a
else do
b
val <- forall a. Storable a => Ptr a -> IO a
peek Ptr b
p
t -> Ptr b -> [b] -> IO [b]
helper (t
s forall a. Num a => a -> a -> a
- t
1) (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr b
p (forall a. Storable a => a -> Int
sizeOf b
val)) (b
val 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 = forall a. Storable a => Int -> Ptr a -> IO [a]
peekStaticArray Int
size (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
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
pokeStaticArray Ptr a
ptr (a
x : [a]
xs) = forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> [a] -> IO ()
pokeStaticArray (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr a
ptr forall a b. (a -> b) -> a -> b
$ 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 = forall a. Storable a => Ptr a -> [a] -> IO ()
pokeStaticArray (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 = forall a. Int -> [a] -> [a]
take Int
size forall a b. (a -> b) -> a -> b
$ [a]
arr forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat a
val