{-# OPTIONS -Wall -Wno-unrecognised-pragmas #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# HLINT ignore "Redundant lambda" #-}

-- | Internal functions for running in a browser
--
--   /NOTE: This module is only used when building for the web/
module Raylib.Internal.Web.Native
  ( callRaylibFunction,
    jslog,
    jsfree,
    p'jsfree,
    CallRaylibType (..),
  )
where

import Foreign (FunPtr, Ptr, Storable (peek, sizeOf), castPtr, free, mallocArray, pokeArray)
import Foreign.C (CChar, CString, CUChar (..), CUInt (..), castCharToCChar, withCStringLen)
import Raylib.Internal.Web.Processable
  ( Processable (processableType),
    ProcessedParam (..),
    processParam,
  )

-- | For \"varargs\" function calls, based on https://wiki.haskell.org/Varargs
class CallRaylibType t where
  callRaylibFunction' :: String -> IO [ProcessedParam] -> t

instance (Storable a, Processable a) => CallRaylibType (IO a) where
  callRaylibFunction' :: String -> IO [ProcessedParam] -> IO a
callRaylibFunction' String
func IO [ProcessedParam]
params' = do
    [ProcessedParam]
params <- IO [ProcessedParam]
params'
    String -> [ProcessedParam] -> IO a
forall a.
(Storable a, Processable a) =>
String -> [ProcessedParam] -> IO a
callRaylibFunctionRaw String
func [ProcessedParam]
params

instance (Storable a, Processable a, CallRaylibType r) => CallRaylibType (a -> r) where
  callRaylibFunction' :: String -> IO [ProcessedParam] -> a -> r
callRaylibFunction' String
func IO [ProcessedParam]
params' = \a
x ->
    String -> IO [ProcessedParam] -> r
forall t. CallRaylibType t => String -> IO [ProcessedParam] -> t
callRaylibFunction'
      String
func
      ( do
          [ProcessedParam]
params <- IO [ProcessedParam]
params'
          ProcessedParam
param <- a -> IO ProcessedParam
forall a. (Processable a, Storable a) => a -> IO ProcessedParam
processParam a
x
          [ProcessedParam] -> IO [ProcessedParam]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ProcessedParam] -> IO [ProcessedParam])
-> [ProcessedParam] -> IO [ProcessedParam]
forall a b. (a -> b) -> a -> b
$ [ProcessedParam]
params [ProcessedParam] -> [ProcessedParam] -> [ProcessedParam]
forall a. [a] -> [a] -> [a]
++ [ProcessedParam
param]
      )

callRaylibFunctionRaw :: forall a. (Storable a, Processable a) => String -> [ProcessedParam] -> IO a
callRaylibFunctionRaw :: forall a.
(Storable a, Processable a) =>
String -> [ProcessedParam] -> IO a
callRaylibFunctionRaw String
func [ProcessedParam]
params = do
  let l :: Int
l = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
func
      p :: Int
p = [ProcessedParam] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ProcessedParam]
params
  Ptr CChar
namePtr <- Int -> IO (Ptr CChar)
forall a. Storable a => Int -> IO (Ptr a)
mallocArray Int
l
  Ptr CChar -> [CChar] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr CChar
namePtr ((Char -> CChar) -> String -> [CChar]
forall a b. (a -> b) -> [a] -> [b]
map Char -> CChar
castCharToCChar String
func :: [CChar])
  let nameLen :: CUInt
nameLen = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l :: CUInt
      ptrs :: [Ptr ()]
ptrs = (ProcessedParam -> Ptr ()) -> [ProcessedParam] -> [Ptr ()]
forall a b. (a -> b) -> [a] -> [b]
map (\(ProcessedParam Ptr ()
ptr Int
_ Int
_) -> Ptr ()
ptr) [ProcessedParam]
params
      sizes :: [CUInt]
sizes = (ProcessedParam -> CUInt) -> [ProcessedParam] -> [CUInt]
forall a b. (a -> b) -> [a] -> [b]
map (\(ProcessedParam Ptr ()
_ Int
size Int
_) -> Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) [ProcessedParam]
params :: [CUInt]
      signs :: [CUChar]
signs = (ProcessedParam -> CUChar) -> [ProcessedParam] -> [CUChar]
forall a b. (a -> b) -> [a] -> [b]
map (\(ProcessedParam Ptr ()
_ Int
_ Int
pType) -> Int -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pType) [ProcessedParam]
params :: [CUChar]
      numParams :: CUInt
numParams = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p :: CUInt

  Ptr (Ptr ())
ptrsPtr <- Int -> IO (Ptr (Ptr ()))
forall a. Storable a => Int -> IO (Ptr a)
mallocArray Int
p
  Ptr (Ptr ()) -> [Ptr ()] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr (Ptr ())
ptrsPtr [Ptr ()]
ptrs

  Ptr CUInt
sizesPtr <- Int -> IO (Ptr CUInt)
forall a. Storable a => Int -> IO (Ptr a)
mallocArray Int
p
  Ptr CUInt -> [CUInt] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr CUInt
sizesPtr [CUInt]
sizes

  Ptr CUChar
typesPtr <- Int -> IO (Ptr CUChar)
forall a. Storable a => Int -> IO (Ptr a)
mallocArray Int
p
  Ptr CUChar -> [CUChar] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr CUChar
typesPtr [CUChar]
signs

  Ptr ()
resPtr <- Ptr CChar
-> CUInt
-> Ptr (Ptr ())
-> Ptr CUInt
-> Ptr CUChar
-> CUInt
-> CUInt
-> CUChar
-> IO (Ptr ())
c'callRaylibFunction Ptr CChar
namePtr CUInt
nameLen Ptr (Ptr ())
ptrsPtr Ptr CUInt
sizesPtr Ptr CUChar
typesPtr CUInt
numParams (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)) (Int -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUChar) -> Int -> CUChar
forall a b. (a -> b) -> a -> b
$ ParamType -> Int
forall a. Enum a => a -> Int
fromEnum (ParamType -> Int) -> ParamType -> Int
forall a b. (a -> b) -> a -> b
$ a -> ParamType
forall a. Processable a => a -> ParamType
processableType (a
forall a. HasCallStack => a
undefined :: a))
  a
res <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek (Ptr () -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
resPtr)

  Ptr () -> IO ()
jsfree Ptr ()
resPtr
  Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
free Ptr CChar
namePtr
  Ptr (Ptr ()) -> IO ()
forall a. Ptr a -> IO ()
free Ptr (Ptr ())
ptrsPtr
  (Ptr () -> IO ()) -> [Ptr ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Ptr () -> IO ()
forall a. Ptr a -> IO ()
free [Ptr ()]
ptrs
  Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
free Ptr CUInt
sizesPtr
  Ptr CUChar -> IO ()
forall a. Ptr a -> IO ()
free Ptr CUChar
typesPtr

  a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

jslog :: String -> IO ()
jslog :: String -> IO ()
jslog String
str = String -> (CStringLen -> IO ()) -> IO ()
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str (\(Ptr CChar
s, Int
len) -> Ptr CChar -> CUInt -> IO ()
c'jslog Ptr CChar
s (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))

-- | This is an interfacing function that allows Haskell to call raylib
--   functions that have been compiled with emscripten. This has to be done in
--   a roundabout way because we cannot directly call these functions through
--   Haskell; we have to call a JS proxy function that calls the actual raylib
--   functions.
callRaylibFunction :: (CallRaylibType t) => String -> t
callRaylibFunction :: forall t. CallRaylibType t => String -> t
callRaylibFunction String
func = String -> IO [ProcessedParam] -> t
forall t. CallRaylibType t => String -> IO [ProcessedParam] -> t
callRaylibFunction' String
func ([ProcessedParam] -> IO [ProcessedParam]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [])

#ifdef WEB_FFI

foreign import ccall "main.h jslog" c'jslog :: CString -> CUInt -> IO ()

foreign import ccall "main.h jsfree" jsfree :: Ptr () -> IO ()

foreign import ccall "main.h &jsfree" p'jsfree :: FunPtr (Ptr a -> IO ())

foreign import ccall "main.h callRaylibFunction" c'callRaylibFunction :: CString -> CUInt -> Ptr (Ptr ()) -> Ptr CUInt -> Ptr CUChar -> CUInt -> CUInt -> CUChar -> IO (Ptr ())

#else

c'jslog :: CString -> CUInt -> IO ()
c'jslog :: Ptr CChar -> CUInt -> IO ()
c'jslog = String -> Ptr CChar -> CUInt -> IO ()
forall a. HasCallStack => String -> a
error String
"(c'jslog) Not running in the web!"

jsfree :: Ptr () -> IO ()
jsfree :: Ptr () -> IO ()
jsfree = String -> Ptr () -> IO ()
forall a. HasCallStack => String -> a
error String
"(jsfree) Not running in the web!"

p'jsfree :: FunPtr (Ptr a -> IO ())
p'jsfree :: forall a. FunPtr (Ptr a -> IO ())
p'jsfree = String -> FunPtr (Ptr a -> IO ())
forall a. HasCallStack => String -> a
error String
"(p'jsfree) Not running in the web!"

c'callRaylibFunction :: CString -> CUInt -> Ptr (Ptr ()) -> Ptr CUInt -> Ptr CUChar -> CUInt -> CUInt -> CUChar -> IO (Ptr ())
c'callRaylibFunction :: Ptr CChar
-> CUInt
-> Ptr (Ptr ())
-> Ptr CUInt
-> Ptr CUChar
-> CUInt
-> CUInt
-> CUChar
-> IO (Ptr ())
c'callRaylibFunction = String
-> Ptr CChar
-> CUInt
-> Ptr (Ptr ())
-> Ptr CUInt
-> Ptr CUChar
-> CUInt
-> CUInt
-> CUChar
-> IO (Ptr ())
forall a. HasCallStack => String -> a
error String
"(c'callRaylibFunction): Not running in the web!"

#endif