{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances #-} module LLVM.Internal.MemoryBuffer where import LLVM.Prelude import Control.Monad.AnyCont import Control.Monad.Catch import Control.Monad.IO.Class import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BS import Foreign.Ptr import LLVM.Exception import LLVM.Internal.Coding import LLVM.Internal.String import qualified LLVM.Internal.FFI.LLVMCTypes as FFI import qualified LLVM.Internal.FFI.MemoryBuffer as FFI data Specification = Bytes { Specification -> String name :: String, Specification -> ByteString content :: BS.ByteString } | File { Specification -> String pathName :: String } instance (MonadThrow m, MonadIO m, MonadAnyCont IO m) => EncodeM m Specification (FFI.OwnerTransfered (Ptr FFI.MemoryBuffer)) where encodeM :: Specification -> m (OwnerTransfered (Ptr MemoryBuffer)) encodeM spec :: Specification spec = (Ptr MemoryBuffer -> OwnerTransfered (Ptr MemoryBuffer)) -> m (Ptr MemoryBuffer) -> m (OwnerTransfered (Ptr MemoryBuffer)) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r liftM Ptr MemoryBuffer -> OwnerTransfered (Ptr MemoryBuffer) forall a. a -> OwnerTransfered a FFI.OwnerTransfered (m (Ptr MemoryBuffer) -> m (OwnerTransfered (Ptr MemoryBuffer))) -> m (Ptr MemoryBuffer) -> m (OwnerTransfered (Ptr MemoryBuffer)) forall a b. (a -> b) -> a -> b $ do case Specification spec of Bytes name :: String name content :: ByteString content -> do (s :: Ptr CChar s,l :: Int l) <- (forall r. ((Ptr CChar, Int) -> IO r) -> IO r) -> m (Ptr CChar, Int) forall (b :: * -> *) (m :: * -> *) a. MonadAnyCont b m => (forall r. (a -> b r) -> b r) -> m a anyContToM ((forall r. ((Ptr CChar, Int) -> IO r) -> IO r) -> m (Ptr CChar, Int)) -> (forall r. ((Ptr CChar, Int) -> IO r) -> IO r) -> m (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.unsafeUseAsCStringLen (ByteString -> Word8 -> ByteString BS.snoc ByteString content 0) Ptr CChar name <- String -> m (Ptr CChar) forall (e :: * -> *) h c. EncodeM e h c => h -> e c encodeM String name LLVMBool nullTerminate <- Bool -> m LLVMBool forall (e :: * -> *) h c. EncodeM e h c => h -> e c encodeM Bool True IO (Ptr MemoryBuffer) -> m (Ptr MemoryBuffer) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Ptr MemoryBuffer) -> m (Ptr MemoryBuffer)) -> IO (Ptr MemoryBuffer) -> m (Ptr MemoryBuffer) forall a b. (a -> b) -> a -> b $ Ptr CChar -> CSize -> Ptr CChar -> LLVMBool -> IO (Ptr MemoryBuffer) FFI.createMemoryBufferWithMemoryRange Ptr CChar s (Int -> CSize forall a b. (Integral a, Num b) => a -> b fromIntegral (Int lInt -> Int -> Int forall a. Num a => a -> a -> a -1)) Ptr CChar name LLVMBool nullTerminate File pathName :: String pathName -> do Ptr CChar pathName <- String -> m (Ptr CChar) forall (e :: * -> *) h c. EncodeM e h c => h -> e c encodeM String pathName Ptr (Ptr MemoryBuffer) mbPtr <- m (Ptr (Ptr MemoryBuffer)) forall a (m :: * -> *). (Storable a, MonadAnyCont IO m) => m (Ptr a) alloca Ptr (OwnerTransfered (Ptr CChar)) msgPtr <- m (Ptr (OwnerTransfered (Ptr CChar))) forall a (m :: * -> *). (Storable a, MonadAnyCont IO m) => m (Ptr a) alloca Bool result <- LLVMBool -> m Bool forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM (LLVMBool -> m Bool) -> m LLVMBool -> m Bool forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< (IO LLVMBool -> m LLVMBool forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO LLVMBool -> m LLVMBool) -> IO LLVMBool -> m LLVMBool forall a b. (a -> b) -> a -> b $ Ptr CChar -> Ptr (Ptr MemoryBuffer) -> Ptr (OwnerTransfered (Ptr CChar)) -> IO LLVMBool FFI.createMemoryBufferWithContentsOfFile Ptr CChar pathName Ptr (Ptr MemoryBuffer) mbPtr Ptr (OwnerTransfered (Ptr CChar)) msgPtr) Bool -> m () -> m () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool result (m () -> m ()) -> m () -> m () forall a b. (a -> b) -> a -> b $ do String msg <- Ptr (OwnerTransfered (Ptr CChar)) -> m String forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM Ptr (OwnerTransfered (Ptr CChar)) msgPtr EncodeException -> m () forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a throwM (String -> EncodeException EncodeException String msg) Ptr (Ptr MemoryBuffer) -> m (Ptr MemoryBuffer) forall a (m :: * -> *). (Storable a, MonadIO m) => Ptr a -> m a peek Ptr (Ptr MemoryBuffer) mbPtr instance (MonadThrow m, MonadIO m, MonadAnyCont IO m) => EncodeM m Specification (Ptr FFI.MemoryBuffer) where encodeM :: Specification -> m (Ptr MemoryBuffer) encodeM spec :: Specification spec = do FFI.OwnerTransfered mb :: Ptr MemoryBuffer mb <- Specification -> m (OwnerTransfered (Ptr MemoryBuffer)) forall (e :: * -> *) h c. EncodeM e h c => h -> e c encodeM Specification spec (forall r. (Ptr MemoryBuffer -> IO r) -> IO r) -> m (Ptr MemoryBuffer) forall (b :: * -> *) (m :: * -> *) a. MonadAnyCont b m => (forall r. (a -> b r) -> b r) -> m a anyContToM ((forall r. (Ptr MemoryBuffer -> IO r) -> IO r) -> m (Ptr MemoryBuffer)) -> (forall r. (Ptr MemoryBuffer -> IO r) -> IO r) -> m (Ptr MemoryBuffer) forall a b. (a -> b) -> a -> b $ IO (Ptr MemoryBuffer) -> (Ptr MemoryBuffer -> IO ()) -> (Ptr MemoryBuffer -> IO r) -> IO r forall (m :: * -> *) a c b. MonadMask m => m a -> (a -> m c) -> (a -> m b) -> m b bracket (Ptr MemoryBuffer -> IO (Ptr MemoryBuffer) forall (m :: * -> *) a. Monad m => a -> m a return Ptr MemoryBuffer mb) Ptr MemoryBuffer -> IO () FFI.disposeMemoryBuffer instance MonadIO d => DecodeM d BS.ByteString (Ptr FFI.MemoryBuffer) where decodeM :: Ptr MemoryBuffer -> d ByteString decodeM p :: Ptr MemoryBuffer p = do Ptr CChar s <- IO (Ptr CChar) -> d (Ptr CChar) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Ptr CChar) -> d (Ptr CChar)) -> IO (Ptr CChar) -> d (Ptr CChar) forall a b. (a -> b) -> a -> b $ Ptr MemoryBuffer -> IO (Ptr CChar) FFI.getBufferStart Ptr MemoryBuffer p CSize l <- IO CSize -> d CSize forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO CSize -> d CSize) -> IO CSize -> d CSize forall a b. (a -> b) -> a -> b $ Ptr MemoryBuffer -> IO CSize FFI.getBufferSize Ptr MemoryBuffer p IO ByteString -> d ByteString forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO ByteString -> d ByteString) -> IO ByteString -> d ByteString forall a b. (a -> b) -> a -> b $ (Ptr CChar, Int) -> IO ByteString BS.packCStringLen (Ptr CChar s, CSize -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral CSize l) instance MonadIO d => DecodeM d String (Ptr FFI.MemoryBuffer) where decodeM :: Ptr MemoryBuffer -> d String decodeM = UTF8ByteString -> d String forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM (UTF8ByteString -> d String) -> (ByteString -> UTF8ByteString) -> ByteString -> d String forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> UTF8ByteString UTF8ByteString (ByteString -> d String) -> (Ptr MemoryBuffer -> d ByteString) -> Ptr MemoryBuffer -> d String forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< Ptr MemoryBuffer -> d ByteString forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM