-- 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/Protocols/Sequence.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.Protocols.Sequence
	( Sequence (..)
	, SomeSequence
	, castToSequence
	, length
	, append
	, repeat
	, inPlaceAppend
	, inPlaceRepeat
	, getItem
	, setItem
	, deleteItem
	, getSlice
	, setSlice
	, deleteSlice
	, count
	, contains
	, index
	, toList
	, toTuple
	, fast
	) where


import           Prelude hiding (repeat, length)
import           Data.Text (Text)

import           CPython.Internal
import           CPython.Types.ByteArray (ByteArray)
import           CPython.Types.Bytes (Bytes)
import           CPython.Types.Unicode (Unicode)

instance Sequence ByteArray where
	toSequence = unsafeCastToSequence

instance Sequence Bytes where
	toSequence = unsafeCastToSequence

instance Sequence List where
	toSequence = unsafeCastToSequence

instance Sequence Tuple where
	toSequence = unsafeCastToSequence

instance Sequence Unicode where
	toSequence = unsafeCastToSequence

-- | Attempt to convert an object to a generic 'Sequence'. If the object does
-- not implement the sequence protocol, returns 'Nothing'.
castToSequence :: Object a => a -> IO (Maybe SomeSequence)
castToSequence obj =
	withObject obj $ \objPtr -> do
	isSequence <- fmap cToBool $ pySequenceCheck objPtr
	return $ if isSequence
		then Just $ unsafeCastToSequence obj
		else Nothing

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

append :: (Sequence a, Sequence b) => a -> b -> IO (SomeSequence)
append a1 a2 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  append'_ a1' a2' >>= \res ->
  stealObject res >>= \res' ->
  return (res')
{-# LINE 85 "lib/CPython/Protocols/Sequence.chs" #-}

repeat :: Sequence a => a -> Integer -> IO (a)
repeat a1 a2 =
  withObject a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  repeat'_ a1' a2' >>= \res ->
  stealObject res >>= \res' ->
  return (res')
{-# LINE 91 "lib/CPython/Protocols/Sequence.chs" #-}

inPlaceAppend :: (Sequence a, Sequence b) => a -> b -> IO (SomeSequence)
inPlaceAppend a1 a2 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  inPlaceAppend'_ a1' a2' >>= \res ->
  stealObject res >>= \res' ->
  return (res')
{-# LINE 97 "lib/CPython/Protocols/Sequence.chs" #-}

inPlaceRepeat :: Sequence a => a -> Integer -> IO (a)
inPlaceRepeat a1 a2 =
  withObject a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  inPlaceRepeat'_ a1' a2' >>= \res ->
  stealObject res >>= \res' ->
  return (res')
{-# LINE 103 "lib/CPython/Protocols/Sequence.chs" #-}

getItem :: Sequence self => self -> Integer -> IO (SomeObject)
getItem a1 a2 =
  withObject a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  getItem'_ a1' a2' >>= \res ->
  stealObject res >>= \res' ->
  return (res')
{-# LINE 109 "lib/CPython/Protocols/Sequence.chs" #-}

setItem :: (Sequence self, Object v) => self -> Integer -> v -> IO (())
setItem a1 a2 a3 =
  withObject a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  withObject a3 $ \a3' -> 
  setItem'_ a1' a2' a3' >>= \res ->
  checkStatusCode res >>= \res' ->
  return (res')
{-# LINE 116 "lib/CPython/Protocols/Sequence.chs" #-}

deleteItem :: Sequence self => self -> Integer -> IO (())
deleteItem a1 a2 =
  withObject a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  deleteItem'_ a1' a2' >>= \res ->
  checkStatusCode res >>= \res' ->
  return (res')
{-# LINE 122 "lib/CPython/Protocols/Sequence.chs" #-}

getSlice :: Sequence self => self -> Integer -> Integer -> IO (SomeObject)
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 129 "lib/CPython/Protocols/Sequence.chs" #-}

setSlice :: (Sequence self, Object v) => self -> Integer -> Integer -> v -> IO (())
setSlice a1 a2 a3 a4 =
  withObject a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  withObject a4 $ \a4' -> 
  setSlice'_ a1' a2' a3' a4' >>= \res ->
  checkStatusCode res >>= \res' ->
  return (res')
{-# LINE 137 "lib/CPython/Protocols/Sequence.chs" #-}

deleteSlice :: Sequence self => self -> Integer -> Integer -> IO (())
deleteSlice a1 a2 a3 =
  withObject a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  deleteSlice'_ a1' a2' a3' >>= \res ->
  checkStatusCode res >>= \res' ->
  return (res')
{-# LINE 144 "lib/CPython/Protocols/Sequence.chs" #-}

count :: (Sequence self, Object v) => self -> v -> IO (Integer)
count a1 a2 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  count'_ a1' a2' >>= \res ->
  checkIntReturn res >>= \res' ->
  return (res')
{-# LINE 150 "lib/CPython/Protocols/Sequence.chs" #-}

contains :: (Sequence self, Object v) => self -> v -> IO (Bool)
contains a1 a2 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  contains'_ a1' a2' >>= \res ->
  checkBoolReturn res >>= \res' ->
  return (res')
{-# LINE 156 "lib/CPython/Protocols/Sequence.chs" #-}

-- | Return the first index /i/ for which @self[i] == v@. This is equivalent
-- to the Python expression @self.index(v)@.
index :: (Sequence self, Object v) => self -> v -> IO (Integer)
index a1 a2 =
  withObject a1 $ \a1' -> 
  withObject a2 $ \a2' -> 
  index'_ a1' a2' >>= \res ->
  checkIntReturn res >>= \res' ->
  return (res')
{-# LINE 164 "lib/CPython/Protocols/Sequence.chs" #-}

-- | Return a list object with the same contents as the arbitrary sequence
-- /seq/. The returned list is guaranteed to be new.
toList :: Sequence seq => seq -> IO (List)
toList a1 =
  withObject a1 $ \a1' -> 
  toList'_ a1' >>= \res ->
  stealObject res >>= \res' ->
  return (res')
{-# LINE 171 "lib/CPython/Protocols/Sequence.chs" #-}

-- | Return a tuple object with the same contents as the arbitrary sequence
-- /seq/. If /seq/ is already a tuple, it is re-used rather than copied.
toTuple :: Sequence seq => seq -> IO (Tuple)
toTuple a1 =
  withObject a1 $ \a1' -> 
  toTuple'_ a1' >>= \res ->
  stealObject res >>= \res' ->
  return (res')
{-# LINE 178 "lib/CPython/Protocols/Sequence.chs" #-}

-- | Returns the sequence /seq/ as a tuple, unless it is already a tuple or
-- list, in which case /seq/ is returned. If an error occurs, throws
-- @TypeError@ with the given text as the exception text.
fast :: Sequence seq => seq -> Text -> IO (SomeSequence)
fast a1 a2 =
  withObject a1 $ \a1' -> 
  withText a2 $ \a2' -> 
  fast'_ a1' a2' >>= \res ->
  stealObject res >>= \res' ->
  return (res')
{-# LINE 187 "lib/CPython/Protocols/Sequence.chs" #-}

foreign import ccall safe "CPython/Protocols/Sequence.chs.h PySequence_Check"
  pySequenceCheck :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "CPython/Protocols/Sequence.chs.h PySequence_Size"
  length'_ :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "CPython/Protocols/Sequence.chs.h PySequence_Concat"
  append'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))

foreign import ccall safe "CPython/Protocols/Sequence.chs.h PySequence_Repeat"
  repeat'_ :: ((Ptr ()) -> (CInt -> (IO (Ptr ()))))

foreign import ccall safe "CPython/Protocols/Sequence.chs.h PySequence_InPlaceConcat"
  inPlaceAppend'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))

foreign import ccall safe "CPython/Protocols/Sequence.chs.h PySequence_InPlaceRepeat"
  inPlaceRepeat'_ :: ((Ptr ()) -> (CInt -> (IO (Ptr ()))))

foreign import ccall safe "CPython/Protocols/Sequence.chs.h PySequence_GetItem"
  getItem'_ :: ((Ptr ()) -> (CInt -> (IO (Ptr ()))))

foreign import ccall safe "CPython/Protocols/Sequence.chs.h PySequence_SetItem"
  setItem'_ :: ((Ptr ()) -> (CInt -> ((Ptr ()) -> (IO CInt))))

foreign import ccall safe "CPython/Protocols/Sequence.chs.h PySequence_DelItem"
  deleteItem'_ :: ((Ptr ()) -> (CInt -> (IO CInt)))

foreign import ccall safe "CPython/Protocols/Sequence.chs.h PySequence_GetSlice"
  getSlice'_ :: ((Ptr ()) -> (CInt -> (CInt -> (IO (Ptr ())))))

foreign import ccall safe "CPython/Protocols/Sequence.chs.h PySequence_SetSlice"
  setSlice'_ :: ((Ptr ()) -> (CInt -> (CInt -> ((Ptr ()) -> (IO CInt)))))

foreign import ccall safe "CPython/Protocols/Sequence.chs.h PySequence_DelSlice"
  deleteSlice'_ :: ((Ptr ()) -> (CInt -> (CInt -> (IO CInt))))

foreign import ccall safe "CPython/Protocols/Sequence.chs.h PySequence_Count"
  count'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO CInt)))

foreign import ccall safe "CPython/Protocols/Sequence.chs.h PySequence_Contains"
  contains'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO CInt)))

foreign import ccall safe "CPython/Protocols/Sequence.chs.h PySequence_Index"
  index'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO CInt)))

foreign import ccall safe "CPython/Protocols/Sequence.chs.h PySequence_List"
  toList'_ :: ((Ptr ()) -> (IO (Ptr ())))

foreign import ccall safe "CPython/Protocols/Sequence.chs.h PySequence_Tuple"
  toTuple'_ :: ((Ptr ()) -> (IO (Ptr ())))

foreign import ccall safe "CPython/Protocols/Sequence.chs.h PySequence_Fast"
  fast'_ :: ((Ptr ()) -> ((Ptr CChar) -> (IO (Ptr ()))))