-- 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/Tuple.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.Tuple
	( Tuple
	, tupleType
	, toTuple
	, iterableToTuple
	, fromTuple
	, length
	, getItem
	, getSlice
	, setItem
	) where


import           Prelude hiding (length)

import           CPython.Internal hiding (new)

instance Concrete Tuple where
	concreteType _ = tupleType

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

toTuple :: [SomeObject] -> IO Tuple
toTuple xs =
	mapWith withObject xs $ \ptrs ->
	withArrayLen ptrs $ \count array ->
	hscpython_poke_tuple (fromIntegral count) array
	>>= stealObject

-- | Convert any object implementing the iterator protocol to a 'Tuple'.
iterableToTuple :: Object iter => iter -> IO Tuple
iterableToTuple iter = do
	raw <- callObjectRaw tupleType =<< toTuple [toObject iter]
	return $ unsafeCast raw

fromTuple :: Tuple -> IO [SomeObject]
fromTuple py =
	withObject py $ \pyPtr ->
	(pyTupleSize pyPtr >>=) $ \size ->
	let size' = fromIntegral size :: Int in
	withArray (replicate size' nullPtr) $ \ptrs ->
	hscpython_peek_tuple pyPtr size ptrs >>
	peekArray size' ptrs >>= mapM peekObject

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

-- | Return the object at a given index from a tuple, or throws @IndexError@
-- if the index is out of bounds.
getItem :: Tuple -> Integer -> IO (SomeObject)
getItem a1 a2 =
  withObject a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  getItem'_ a1' a2' >>= \res ->
  peekObject res >>= \res' ->
  return (res')
{-# LINE 73 "lib/CPython/Types/Tuple.chs" #-}

-- | Take a slice of a tuple from /low/ to /high/, and return it as a new
-- tuple.
getSlice :: Tuple -> Integer -> Integer -> IO (Tuple)
getSlice a1 a2 a3 =
  withObject a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  getSlice'_ a1' a2' a3' >>= \res ->
  stealObject res >>= \res' ->
  return (res')
{-# LINE 81 "lib/CPython/Types/Tuple.chs" #-}

setItem :: Object o => Tuple -> Integer -> o -> IO ()
setItem self index x =
	withObject self $ \selfPtr ->
	withObject x $ \xPtr -> do
	incref xPtr
	pyTupleSetItem selfPtr (fromIntegral index) xPtr
	>>= checkStatusCode

foreign import ccall unsafe "CPython/Types/Tuple.chs.h hscpython_PyTuple_Type"
  tupleType'_ :: (Ptr ())

foreign import ccall safe "CPython/Types/Tuple.chs.h hscpython_poke_tuple"
  hscpython_poke_tuple :: (CUInt -> ((Ptr (Ptr ())) -> (IO (Ptr ()))))

foreign import ccall safe "CPython/Types/Tuple.chs.h PyTuple_Size"
  pyTupleSize :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "CPython/Types/Tuple.chs.h hscpython_peek_tuple"
  hscpython_peek_tuple :: ((Ptr ()) -> (CInt -> ((Ptr (Ptr ())) -> (IO ()))))

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

foreign import ccall safe "CPython/Types/Tuple.chs.h PyTuple_GetItem"
  getItem'_ :: ((Ptr ()) -> (CInt -> (IO (Ptr ()))))

foreign import ccall safe "CPython/Types/Tuple.chs.h PyTuple_GetSlice"
  getSlice'_ :: ((Ptr ()) -> (CInt -> (CInt -> (IO (Ptr ())))))

foreign import ccall safe "CPython/Types/Tuple.chs.h PyTuple_SetItem"
  pyTupleSetItem :: ((Ptr ()) -> (CInt -> ((Ptr ()) -> (IO CInt))))