-- GENERATED by C->Haskell Compiler, version 0.16.4 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "lib/CPython/Types/ByteArray.chs" #-}{-# LANGUAGE ForeignFunctionInterface #-}

-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

module CPython.Types.ByteArray
	( ByteArray
	, byteArrayType
	, toByteArray
	, fromByteArray
	, fromObject
	, append
	, length
	, resize
	) where


import           Prelude hiding (length)
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B

import           CPython.Internal

newtype ByteArray = ByteArray (ForeignPtr ByteArray)

instance Object ByteArray where
	toObject (ByteArray x) = SomeObject x
	fromForeignPtr = ByteArray

instance Concrete ByteArray where
	concreteType _ = byteArrayType

byteArrayType :: Type
byteArrayType =
  unsafePerformIO $
  let {res = byteArrayType'_} in
  peekStaticObject res >>= \res' ->
  return (res')
{-# LINE 47 "lib/CPython/Types/ByteArray.chs" #-}

toByteArray :: B.ByteString -> IO ByteArray
toByteArray bytes = let
	mkByteArray = pyByteArrayFromStringAndSize
{-# LINE 51 "lib/CPython/Types/ByteArray.chs" #-}
	in B.unsafeUseAsCStringLen bytes $ \(cstr, len) ->
	   stealObject =<< mkByteArray cstr (fromIntegral len)

fromByteArray :: ByteArray -> IO B.ByteString
fromByteArray py =
	withObject py $ \pyPtr -> do
	size' <- pyByteArraySize pyPtr
	bytes <- pyByteArrayAsString pyPtr
	B.packCStringLen (bytes, fromIntegral size')

-- | Create a new byte array from any object which implements the buffer
-- protocol.
fromObject :: Object self  => self -> IO (ByteArray)
fromObject a1 =
  withObject a1 $ \a1' -> 
  fromObject'_ a1' >>= \res ->
  stealObject res >>= \res' ->
  return (res')
{-# LINE 67 "lib/CPython/Types/ByteArray.chs" #-}

append :: ByteArray -> ByteArray -> IO (ByteArray)
append a1 a2 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  append'_ a1' a2' >>= \res ->
  stealObject res >>= \res' ->
  return (res')
{-# LINE 72 "lib/CPython/Types/ByteArray.chs" #-}

length :: ByteArray -> IO (Integer)
length a1 =
  withObject a1 $ \a1' -> 
  length'_ a1' >>= \res ->
  checkIntReturn res >>= \res' ->
  return (res')
{-# LINE 76 "lib/CPython/Types/ByteArray.chs" #-}

resize :: ByteArray -> Integer -> IO (())
resize a1 a2 =
  withObject a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  resize'_ a1' a2' >>= \res ->
  checkStatusCode res >>= \res' ->
  return (res')
{-# LINE 81 "lib/CPython/Types/ByteArray.chs" #-}

foreign import ccall unsafe "CPython/Types/ByteArray.chs.h hscpython_PyByteArray_Type"
  byteArrayType'_ :: (Ptr ())

foreign import ccall safe "CPython/Types/ByteArray.chs.h PyByteArray_FromStringAndSize"
  pyByteArrayFromStringAndSize :: ((Ptr CChar) -> (CInt -> (IO (Ptr ()))))

foreign import ccall safe "CPython/Types/ByteArray.chs.h PyByteArray_Size"
  pyByteArraySize :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "CPython/Types/ByteArray.chs.h PyByteArray_AsString"
  pyByteArrayAsString :: ((Ptr ()) -> (IO (Ptr CChar)))

foreign import ccall safe "CPython/Types/ByteArray.chs.h PyByteArray_FromObject"
  fromObject'_ :: ((Ptr ()) -> (IO (Ptr ())))

foreign import ccall safe "CPython/Types/ByteArray.chs.h PyByteArray_Concat"
  append'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))

foreign import ccall safe "CPython/Types/ByteArray.chs.h PyByteArray_Size"
  length'_ :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "CPython/Types/ByteArray.chs.h PyByteArray_Resize"
  resize'_ :: ((Ptr ()) -> (CInt -> (IO CInt)))