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


{-# LINE 1 "lib/CPython/Types/List.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.List
	( List
	, listType
	, toList
	, iterableToList
	, fromList
	, length
	, getItem
	, setItem
	, insert
	, append
	, getSlice
	, setSlice
	, sort
	, reverse
	, toTuple
	) where



import           Prelude hiding (reverse, length)

import           CPython.Internal hiding (new)
import qualified CPython.Types.Tuple as T

instance Concrete List where
	concreteType _ = listType

listType :: (Type)
listType =
  unsafePerformIO $
  let {res = listType'_} in
  peekStaticObject res >>= \res' ->
  return (res')

{-# LINE 47 "lib/CPython/Types/List.chs" #-}


toList :: [SomeObject] -> IO List
toList xs =
	mapWith withObject xs $ \ptrs ->
	withArrayLen ptrs $ \count array ->
	hscpython_poke_list (fromIntegral count) array
	>>= stealObject

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

fromList :: List -> IO [SomeObject]
fromList py =
	withObject py $ \pyPtr ->
	(pyListSize pyPtr >>=) $ \size ->
	let size' = fromIntegral size :: Int in
	withArray (replicate size' nullPtr) $ \ptrs ->
	hscpython_peek_list pyPtr size ptrs >>
	peekArray size' ptrs >>= mapM peekObject

length :: (List) -> IO ((Integer))
length a1 =
  withObject a1 $ \a1' -> 
  length'_ a1' >>= \res ->
  checkIntReturn res >>= \res' ->
  return (res')

{-# LINE 73 "lib/CPython/Types/List.chs" #-}


-- | Returns the object at a given position in the list. The position must be
-- positive; indexing from the end of the list is not supported. If the
-- position is out of bounds, throws an @IndexError@ exception.
getItem :: (List) -> (Integer) -> IO ((SomeObject))
getItem a1 a2 =
  withObject a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  getItem'_ a1' a2' >>= \res ->
  peekObject res >>= \res' ->
  return (res')

{-# LINE 81 "lib/CPython/Types/List.chs" #-}


-- | Set the item at a given index.
setItem :: Object o => List -> Integer -> o -> IO ()
setItem self index x =
	withObject self $ \selfPtr ->
	withObject x $ \xPtr -> do
	incref xPtr
	pyListSetItem selfPtr (fromIntegral index) xPtr
	>>= checkStatusCode

-- | Inserts /item/ into the list in front of the given index. Throws an
-- exception if unsuccessful. Analogous to @list.insert(index, item)@.
insert :: Object item => (List) -> (Integer) -> (item) -> IO ((()))
insert a1 a2 a3 =
  withObject a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  withObject a3 $ \a3' -> 
  insert'_ a1' a2' a3' >>= \res ->
  checkStatusCode res >>= \res' ->
  return (res')

{-# LINE 99 "lib/CPython/Types/List.chs" #-}


-- | Append /item/ to the end of th list. Throws an exception if unsuccessful.
-- Analogous to @list.append(item)@.
append :: Object item => (List) -> (item) -> IO ((()))
append a1 a2 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  append'_ a1' a2' >>= \res ->
  checkStatusCode res >>= \res' ->
  return (res')

{-# LINE 107 "lib/CPython/Types/List.chs" #-}


-- | Return a list of the objects in list containing the objects between
-- the given indexes. Throws an exception if unsuccessful. Analogous to
-- @list[low:high]@. Negative indices, as when slicing from Python, are not
-- supported.
getSlice :: (List) -> (Integer) -> (Integer) -> IO ((List))
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 117 "lib/CPython/Types/List.chs" #-}


-- | Sets the slice of a list between /low/ and /high/ to the contents of
-- a replacement list. Analogous to @list[low:high] = replacement@. The
-- replacement may be 'Nothing', indicating the assignment of an empty list
-- (slice deletion). Negative indices, as when slicing from Python, are not
-- supported.
setSlice
	:: List
	-> Integer -- ^ Low
	-> Integer -- ^ High
	-> Maybe List -- ^ Replacement
	-> IO ()
setSlice self low high items = let
	low' = fromIntegral low
	high' = fromIntegral high in
	withObject self $ \selfPtr ->
	maybeWith withObject items $ \itemsPtr -> do
	pyListSetSlice selfPtr low' high' itemsPtr
	>>= checkStatusCode

-- | Sort the items of a list in place. This is equivalent to @list.sort()@.
sort :: (List) -> IO ((()))
sort a1 =
  withObject a1 $ \a1' -> 
  sort'_ a1' >>= \res ->
  checkStatusCode res >>= \res' ->
  return (res')

{-# LINE 141 "lib/CPython/Types/List.chs" #-}


-- | Reverses the items of a list in place. This is equivalent to
-- @list.reverse()@.
reverse :: (List) -> IO ((()))
reverse a1 =
  withObject a1 $ \a1' -> 
  reverse'_ a1' >>= \res ->
  checkStatusCode res >>= \res' ->
  return (res')

{-# LINE 147 "lib/CPython/Types/List.chs" #-}


-- | Return a new 'Tuple' containing the contents of a list; equivalent to
-- @tuple(list)@.
toTuple :: (List) -> IO ((Tuple))
toTuple a1 =
  withObject a1 $ \a1' -> 
  toTuple'_ a1' >>= \res ->
  stealObject res >>= \res' ->
  return (res')

{-# LINE 153 "lib/CPython/Types/List.chs" #-}


foreign import ccall unsafe "CPython/Types/List.chs.h hscpython_PyList_Type"
  listType'_ :: (Ptr ())

foreign import ccall safe "CPython/Types/List.chs.h hscpython_poke_list"
  hscpython_poke_list :: (CULong -> ((Ptr (Ptr ())) -> (IO (Ptr ()))))

foreign import ccall safe "CPython/Types/List.chs.h PyList_Size"
  pyListSize :: ((Ptr ()) -> (IO CLong))

foreign import ccall safe "CPython/Types/List.chs.h hscpython_peek_list"
  hscpython_peek_list :: ((Ptr ()) -> (CLong -> ((Ptr (Ptr ())) -> (IO ()))))

foreign import ccall safe "CPython/Types/List.chs.h PyList_Size"
  length'_ :: ((Ptr ()) -> (IO CLong))

foreign import ccall safe "CPython/Types/List.chs.h PyList_GetItem"
  getItem'_ :: ((Ptr ()) -> (CLong -> (IO (Ptr ()))))

foreign import ccall safe "CPython/Types/List.chs.h PyList_SetItem"
  pyListSetItem :: ((Ptr ()) -> (CLong -> ((Ptr ()) -> (IO CInt))))

foreign import ccall safe "CPython/Types/List.chs.h PyList_Insert"
  insert'_ :: ((Ptr ()) -> (CLong -> ((Ptr ()) -> (IO CInt))))

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

foreign import ccall safe "CPython/Types/List.chs.h PyList_GetSlice"
  getSlice'_ :: ((Ptr ()) -> (CLong -> (CLong -> (IO (Ptr ())))))

foreign import ccall safe "CPython/Types/List.chs.h PyList_SetSlice"
  pyListSetSlice :: ((Ptr ()) -> (CLong -> (CLong -> ((Ptr ()) -> (IO CInt)))))

foreign import ccall safe "CPython/Types/List.chs.h PyList_Sort"
  sort'_ :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "CPython/Types/List.chs.h PyList_Reverse"
  reverse'_ :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "CPython/Types/List.chs.h PyList_AsTuple"
  toTuple'_ :: ((Ptr ()) -> (IO (Ptr ())))