{-# 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)

-- Internal utility functions


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