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