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