{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Shaderc.Include where

import Foreign.Ptr
import Foreign.Marshal
import Foreign.Storable
import Foreign.Storable.PeekPoke
import Control.Monad.Trans
import Control.Monad.Cont

import qualified Data.ByteString as BS

import qualified Shaderc.Include.Core as C

data Result ud = Result {
	forall ud. Result ud -> ByteString
resultSourceName :: BS.ByteString,
	forall ud. Result ud -> ByteString
resultContent :: BS.ByteString,
	forall ud. Result ud -> Maybe ud
resultUserData :: Maybe ud }
	deriving Int -> Result ud -> ShowS
[Result ud] -> ShowS
Result ud -> String
(Int -> Result ud -> ShowS)
-> (Result ud -> String)
-> ([Result ud] -> ShowS)
-> Show (Result ud)
forall ud. Show ud => Int -> Result ud -> ShowS
forall ud. Show ud => [Result ud] -> ShowS
forall ud. Show ud => Result ud -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall ud. Show ud => Int -> Result ud -> ShowS
showsPrec :: Int -> Result ud -> ShowS
$cshow :: forall ud. Show ud => Result ud -> String
show :: Result ud -> String
$cshowList :: forall ud. Show ud => [Result ud] -> ShowS
showList :: [Result ud] -> ShowS
Show

resultToCore :: Pokable ud => Result ud -> ContT r IO C.Result
resultToCore :: forall ud r. Pokable ud => Result ud -> ContT r IO Result
resultToCore Result {
	resultSourceName :: forall ud. Result ud -> ByteString
resultSourceName = ByteString
src,
	resultContent :: forall ud. Result ud -> ByteString
resultContent = ByteString
cnt,
	resultUserData :: forall ud. Result ud -> Maybe ud
resultUserData = Maybe ud
ud } = do
	(csrc, fromIntegral -> csrcln) <- (((Ptr CChar, Int) -> IO r) -> IO r) -> ContT r IO (Ptr CChar, Int)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT ((((Ptr CChar, Int) -> IO r) -> IO r)
 -> ContT r IO (Ptr CChar, Int))
-> (((Ptr CChar, Int) -> IO r) -> IO r)
-> ContT r IO (Ptr CChar, Int)
forall a b. (a -> b) -> a -> b
$ ByteString -> ((Ptr CChar, Int) -> IO r) -> IO r
forall a. ByteString -> ((Ptr CChar, Int) -> IO a) -> IO a
BS.useAsCStringLen ByteString
src
	(ccnt, fromIntegral -> ccntln) <- ContT $ BS.useAsCStringLen cnt
	(castPtr -> pud) <- ContT $ withPokedMaybe ud
	pure $ C.Result {
		C.resultSourceName = csrc,
		C.resultSourceNameLength = csrcln,
		C.resultContent = ccnt,
		C.resultContentLength = ccntln,
		C.resultUserData = pud }

type ResolveFn ud =
	Maybe ud -> BS.ByteString -> C.Type -> BS.ByteString -> Int ->
	IO (Result ud)

resolveFnToCore :: Storable ud => ResolveFn ud -> (C.ResolveFn, C.ResultReleaseFn)
resolveFnToCore :: forall ud.
Storable ud =>
ResolveFn ud -> (ResolveFn, ResultReleaseFn)
resolveFnToCore ResolveFn ud
f = (ResolveFn ud -> ResolveFn
forall ud. Storable ud => ResolveFn ud -> ResolveFn
resolveFnToResolveFnCore ResolveFn ud
f, ResultReleaseFn
resultReleaseFn)

resultReleaseFn :: C.ResultReleaseFn
resultReleaseFn :: ResultReleaseFn
resultReleaseFn Ptr ()
pud Ptr Result
prslt = Ptr () -> IO ()
forall a. Ptr a -> IO ()
free Ptr ()
pud 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 Result -> IO ()
forall a. Ptr a -> IO ()
free Ptr Result
prslt

resolveFnToResolveFnCore :: Storable ud => ResolveFn ud -> C.ResolveFn
resolveFnToResolveFnCore :: forall ud. Storable ud => ResolveFn ud -> ResolveFn
resolveFnToResolveFnCore ResolveFn ud
f Ptr ()
pud Ptr CChar
crqtd Type
tp Ptr CChar
crqtng Word64
dpt = do
	ud <- case Ptr ()
pud of
		Ptr ()
NullPtr -> Maybe ud -> IO (Maybe ud)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ud
forall a. Maybe a
Nothing
		Ptr ()
_ -> ud -> Maybe ud
forall a. a -> Maybe a
Just (ud -> Maybe ud) -> IO ud -> IO (Maybe ud)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr ud -> IO ud
forall a. Storable a => Ptr a -> IO a
peek (Ptr () -> Ptr ud
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pud)
	rqtd <- BS.packCString crqtd
	rqtng <- BS.packCString crqtng
	prslt <- malloc
	rslt <- f ud rqtd tp rqtng $ fromIntegral dpt
	($ pure) . runContT
		$ lift . poke prslt =<< resultToCore rslt
	pure prslt