-- GENERATED by C->Haskell Compiler, version 0.28.7 Switcheroo, 25 November 2017 (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 qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified System.IO.Unsafe as C2HSImp





import           Prelude hiding (length)

import           CPython.Internal hiding (new)

instance Concrete Tuple where
  concreteType :: Tuple -> Type
concreteType _ = Type
tupleType

tupleType :: (Type)
tupleType =
  C2HSImp.unsafePerformIO $
  tupleType'_ >>= \res ->
  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 :: Tuple -> IO [SomeObject]
fromTuple py :: Tuple
py =
  Tuple -> (Ptr () -> IO [SomeObject]) -> IO [SomeObject]
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Tuple
py ((Ptr () -> IO [SomeObject]) -> IO [SomeObject])
-> (Ptr () -> IO [SomeObject]) -> IO [SomeObject]
forall a b. (a -> b) -> a -> b
$ \pyPtr :: Ptr ()
pyPtr ->
  (Ptr () -> IO CLong
pyTupleSize Ptr ()
pyPtr IO CLong -> (CLong -> IO [SomeObject]) -> IO [SomeObject]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=) ((CLong -> IO [SomeObject]) -> IO [SomeObject])
-> (CLong -> IO [SomeObject]) -> IO [SomeObject]
forall a b. (a -> b) -> a -> b
$ \size :: CLong
size ->
  let size' :: Int
size' = CLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
size :: Int in
  [Ptr ()] -> (Ptr (Ptr ()) -> IO [SomeObject]) -> IO [SomeObject]
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray (Int -> Ptr () -> [Ptr ()]
forall a. Int -> a -> [a]
replicate Int
size' Ptr ()
forall a. Ptr a
nullPtr) ((Ptr (Ptr ()) -> IO [SomeObject]) -> IO [SomeObject])
-> (Ptr (Ptr ()) -> IO [SomeObject]) -> IO [SomeObject]
forall a b. (a -> b) -> a -> b
$ \ptrs :: Ptr (Ptr ())
ptrs ->
  Ptr () -> CLong -> Ptr (Ptr ()) -> IO ()
hscpython_peek_tuple Ptr ()
pyPtr CLong
size Ptr (Ptr ())
ptrs IO () -> IO [Ptr ()] -> IO [Ptr ()]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Int -> Ptr (Ptr ()) -> IO [Ptr ()]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
size' Ptr (Ptr ())
ptrs IO [Ptr ()] -> ([Ptr ()] -> IO [SomeObject]) -> IO [SomeObject]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr () -> IO SomeObject) -> [Ptr ()] -> IO [SomeObject]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Ptr () -> IO SomeObject
forall obj a. Object obj => Ptr a -> IO obj
peekObject

length :: (Tuple) -> IO ((Integer))
length :: Tuple -> IO Integer
length a1 :: Tuple
a1 =
  Tuple -> (Ptr () -> IO Integer) -> IO Integer
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Tuple
a1 ((Ptr () -> IO Integer) -> IO Integer)
-> (Ptr () -> IO Integer) -> IO Integer
forall a b. (a -> b) -> a -> b
$ \a1' :: Ptr ()
a1' -> 
  Ptr () -> IO CLong
length'_ Ptr ()
a1' IO CLong -> (CLong -> IO Integer) -> IO Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CLong
res ->
  CLong -> IO Integer
forall a. Integral a => a -> IO Integer
checkIntReturn CLong
res IO Integer -> (Integer -> IO Integer) -> IO Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res' :: Integer
res' ->
  Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
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')

getSlice :: Tuple -> Integer -> Integer -> IO Tuple
{-# 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'_ :: (IO (C2HSImp.Ptr ()))

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

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

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

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

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

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

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