content: {-# 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 { name :: String,  content :: BS.ByteString }
    | File { pathName :: String }
  
  instance (MonadThrow m, MonadIO m, MonadAnyCont IO m) => EncodeM m Specification (FFI.OwnerTransfered (Ptr FFI.MemoryBuffer)) where
    encodeM spec = liftM FFI.OwnerTransfered $ do
      case spec of
        Bytes name content -> do
          (s,l) <- anyContToM $ BS.unsafeUseAsCStringLen (BS.snoc content 0)
          name <- encodeM name
          nullTerminate <- encodeM True
          liftIO $ FFI.createMemoryBufferWithMemoryRange s (fromIntegral (l-1)) name nullTerminate
        File pathName -> do
          pathName <- encodeM pathName
          mbPtr <- alloca
          msgPtr <- alloca
          result <- decodeM =<< (liftIO $ FFI.createMemoryBufferWithContentsOfFile pathName mbPtr msgPtr)
          when result $ do
            msg <- decodeM msgPtr
            throwM (EncodeException msg)
          peek mbPtr          
  
  instance (MonadThrow m, MonadIO m, MonadAnyCont IO m) => EncodeM m Specification (Ptr FFI.MemoryBuffer) where
    encodeM spec = do
      FFI.OwnerTransfered mb <- encodeM spec
      anyContToM $ bracket (return mb) FFI.disposeMemoryBuffer
  
  instance MonadIO d => DecodeM d BS.ByteString (Ptr FFI.MemoryBuffer) where
    decodeM p = do
      s <- liftIO $ FFI.getBufferStart p
      l <- liftIO $ FFI.getBufferSize p
      liftIO $ BS.packCStringLen (s, fromIntegral l)
  
  instance MonadIO d => DecodeM d String (Ptr FFI.MemoryBuffer) where
    decodeM = decodeM . UTF8ByteString <=< decodeM
  